vba 快速合并当前文件夹内多个excel的指定工作表到同一个excel的同名工作表并打开,避免提示1004的运行错误
时间: 2023-07-30 07:04:35 浏览: 44
您可以尝试以下的 VBA 代码,它可以实现您的需求:
```
Sub MergeWorksheets()
Dim Path As String, Filename As String, Sheet As Worksheet
Dim CopyRange As Range, DestRange As Range
Dim DestWorkbook As Workbook, SourceWorkbook As Workbook
'设置当前文件夹路径
Path = ThisWorkbook.Path & "\"
'禁用屏幕更新和警告信息
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'循环遍历当前文件夹内的所有 Excel 文件
Filename = Dir(Path & "*.xlsx*")
Do While Filename <> ""
'打开 Excel 文件并获取指定工作表的数据范围
Set SourceWorkbook = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
Set Sheet = SourceWorkbook.Worksheets("Sheet1") '这里假设要合并的工作表名为 Sheet1
Set CopyRange = Sheet.UsedRange
'在目标工作簿中查找同名工作表,如果不存在就新建一个
On Error Resume Next
Set DestWorkbook = Workbooks(ThisWorkbook.Name)
Set Sheet = DestWorkbook.Worksheets(CopyRange.Worksheet.Name)
On Error GoTo 0
If Sheet Is Nothing Then
Set Sheet = DestWorkbook.Worksheets.Add(After:=DestWorkbook.Worksheets(DestWorkbook.Worksheets.Count))
Sheet.Name = CopyRange.Worksheet.Name
End If
'将数据复制到目标工作表中,避免 1004 错误
Set DestRange = Sheet.Range("A1")
DestRange.Resize(CopyRange.Rows.Count, CopyRange.Columns.Count).Value = CopyRange.Value
'关闭源工作簿
SourceWorkbook.Close SaveChanges:=False
'继续处理下一个文件
Filename = Dir()
Loop
'开启屏幕更新和警告信息
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'激活目标工作簿
DestWorkbook.Activate
End Sub
```
请注意,此代码假设要合并的工作表名为 "Sheet1",您可以根据需要更改该部分代码。此外,它还假设当前工作簿是目标工作簿,如果您要将数据合并到不同的工作簿中,请相应地更改代码。