VBA 编写一个宏来将多个电子表格合并成一个电子表格。首先,您需要打开一个新的工作簿,然后在 VBA 编辑器中创建一个新的模块。在模块中,您可以编写代码来打开每个电子表格,并将它们的数据复制到新的工作簿中。最后,您可以将新的工作簿保存为一个电子表格文件的示例程序
时间: 2023-04-04 12:01:54 浏览: 245
Sub MergeWorkbooks()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long, FNum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long
Dim SaveDriveDir As String, FName As Variant
'禁用屏幕更新
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
'获取文件路径
MyPath = "C:\Users\Documents\Excel Files\"
FilesInPath = Dir(MyPath & "*.xlsx")
If FilesInPath = "" Then
MsgBox "没有找到文件"
Exit Sub
End If
'将文件名存储在数组中
FNum =
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop
'打开第一个工作簿并复制数据
Set BaseWks = Workbooks.Open(MyPath & MyFiles(1)).Worksheets(1)
SourceRcount = BaseWks.UsedRange.Rows.Count
Set sourceRange = BaseWks.Range("A1:IV" & SourceRcount)
'将数据复制到新工作簿中
rnum = 1
Set mybook = Workbooks.Add
Set destrange = mybook.Worksheets(1).Range("A1")
sourceRange.Copy destrange
rnum = rnum + SourceRcount
'循环打开其他工作簿并复制数据
If FNum > 1 Then
For FNum = 2 To FNum
Set BaseWks = Workbooks.Open(MyPath & MyFiles(FNum)).Worksheets(1)
SourceRcount = BaseWks.UsedRange.Rows.Count
Set sourceRange = BaseWks.Range("A1:IV" & SourceRcount)
'将数据复制到新工作簿中
Set destrange = mybook.Worksheets(1).Range("A" & rnum)
sourceRange.Copy destrange
rnum = rnum + SourceRcount
BaseWks.Parent.Close False
Next FNum
End If
'保存新工作簿
FName = Application.GetSaveAsFilename(fileFilter:="Microsoft Excel文件 (*.xlsx), *.xlsx")
If FName <> False Then
mybook.SaveAs Filename:=FName
End If
'关闭新工作簿
mybook.Close SaveChanges:=False
'恢复屏幕更新
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
相关推荐
![xlsm](https://img-home.csdnimg.cn/images/20210720083646.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)
![](https://csdnimg.cn/download_wenku/file_type_ask_c1.png)