如何把指定区域带格式保存到另外一个工作表

高云2

如何把表一指定区域带格式保存到另外一个工作表,并以表格中几个单元格相加作为文件名


以下这段代码,复制到新表格后,不知道为什么总是有第一行空白,正常应该直接复制在A1单元格。
另外能否带格式复制粘贴过去,样子如表二。

如果表一中能根据sheet“一站一档汇总表”中G列的“站点名称”
自动调入到"录入登记表"中,然后另存为,能批量挨个的去保存就好了,手动一个一个保存太麻烦了。

如果能自动按照汇总表中
Sub CommandButton1_Click()
Dim Arr, wb As Workbook
Sheets("录入登记表").Activate
Arr = [a2:f91]
Selection.Copy
Set wb = Workbooks.Add  '新建工作簿
With wb
    .Sheets(1).Name = [b6].Value
    With .Sheets(1)
        .[a2].Resize(UBound(Arr), UBound(Arr, 2)) = Arr
    End With
    .SaveAs "E:\统计\" & [d5].Value & "-" & [f5].Value & "-" & [b6].Value & "-" & "202212.xls"
    .Close False
End With
End Sub

3190496160

Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Arr, wb As Workbook
With Sheets("录入登记表")
    mc_1 = .[b6]
    mc_2 = .[d5] & "-" & .[f5] & "-" & .[b6]
    .Copy
End With
Set wb = ActiveWorkbook
With wb.Worksheets(1)
    .Name = mc_1
    For Each shp In .Shapes
        shp.Delete
    Next shp
    .Columns("g:h").Delete
    .Rows(1).Delete
End With
wb.SaveAs "E:\统计\" & [d5].Value & "-" & [f5].Value & "-" & [b6].Value & "-" & Format(Date, "yyyymm") & ".xlsx"
wb.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "导出完毕！"
End Sub

3190496160

一站一档挡案 - 根据机房名称 - 练习模糊查询 - 副本.rar (934.22 KB, 下载次数: 9)

2023-1-15 08:21 上传

点击文件名下载附件

3190496160

批量不是不可以，但是，录入登记表中那么多的项目要从数据源中获取过来，非常繁琐，

高云2

3190496160 发表于 2023-1-15 08:24
批量不是不可以，但是，录入登记表中那么多的项目要从数据源中获取过来，非常繁琐，

谢谢大神,  至少目前解决了第一个难题。
批量不行再说吧,大不了手工一个一个来。

高云2

3190496160 发表于 2023-1-15 08:24
批量不是不可以，但是，录入登记表中那么多的项目要从数据源中获取过来，非常繁琐，

对了,我看了下,如果发给别人这个表,要电脑里有E盘,并创建统计。 如果没有就报错,能不能改成保存到该文件所在的目录下呢。

高云2

高云2 发表于 2023-1-16 10:47
对了,我看了下,如果发给别人这个表,要电脑里有E盘,并创建统计。 如果没有就报错,能不能改成保存到该文件 ...

哈哈,我从别的代码里 找了一个

Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Path = ThisWorkbook.Path & "\"
Dim Arr, wb As Workbook
With Sheets("录入登记表")
    mc_1 = .[b6]
    mc_2 = .[d5] & "-" & .[f5] & "-" & .[b6]
    .Copy
End With
Set wb = ActiveWorkbook
With wb.Worksheets(1)
    .Name = mc_1
    For Each shp In .Shapes
        shp.Delete
    Next shp
    .Columns("g:h").Delete
    .Rows(1).Delete
End With
wb.SaveAs Path & [d5].Value & "-" & [f5].Value & "-" & [b6].Value & "-" & Format(Date, "yyyymm") & ".xlsx"
wb.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "导出完毕！"
End Sub

高云2

3190496160 发表于 2023-1-15 08:20
Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Path = ThisWorkbook.Path & "\"
Dim Arr, wb As Workbook
With Sheets("录入登记表")
    mc_1 = .[b6]
    mc_2 = .[d5] & "-" & .[f5] & "-" & .[b6]
    .Copy
End With
Set wb = ActiveWorkbook
With wb.Worksheets(1)
    .Name = mc_1
    For Each shp In .Shapes
        shp.Delete
    Next shp
    .Columns("g:h").Delete
    .Rows(1).Delete
End With
wb.SaveAs Path & [d5].Value & "-" & [f5].Value & "-" & [b6].Value & "-" & Format(Date, "yyyymm") & ".xlsx"
wb.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "导出完毕！"
End Sub


我改了下,可以保存在该文件的路径下。