用vba写一段代码,合并多个exl中多个sheet
时间: 2023-06-02 21:02:51 浏览: 150
以下是一段可以合并多个Excel文件中多个sheet的VBA代码:
```
Sub MergeSheets()
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim wbSource As Workbook, wbDest As Workbook
Dim wsSource As Worksheet, wsDest As Worksheet
Dim lRow As Long, lCol As Long
'Prompt user to select folder containing Excel files to merge
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
FldrPicker.Title = "Select a Folder"
FldrPicker.Show
myPath = FldrPicker.SelectedItems(1) & "\"
'Set file extension type
myExtension = "*.xls*"
'Loop through all Excel files in folder
myFile = Dir(myPath & myExtension)
Set wbDest = Workbooks.Add(xlWBATWorksheet)
Do While myFile <> ""
'Open each workbook in folder
Set wbSource = Workbooks.Open(myPath & myFile)
'Loop through all worksheets in workbook
For Each wsSource In wbSource.Worksheets
'Copy data from source worksheet to destination workbook
Set wsDest = wbDest.Worksheets.Add(After:=wbDest.Worksheets(wbDest.Worksheets.Count))
wsDest.Name = wsSource.Name
lRow = wsSource.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lCol = wsSource.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
wsSource.Range(Cells(1, 1), Cells(lRow, lCol)).Copy wsDest.Range("A1")
Next wsSource
'Close source workbook
wbSource.Close SaveChanges:=False
'Get next file name
myFile = Dir()
Loop
'Save and close destination workbook
wbDest.SaveAs myPath & "Merged.xlsx", FileFormat:=xlOpenXMLWorkbook
wbDest.Close
'Alert user that the process is complete
MsgBox "Sheets have been merged successfully!"
End Sub
```
此代码将提示用户选择包含要合并的Excel文件的文件夹。然后,它将循环遍历该文件夹中的所有Excel文件,并将每个文件中的每个工作表的数据复制到一个新的工作簿中。最后,它将新工作簿保存为一个名为“Merged.xlsx”的文件。
相关推荐
![pdf](https://img-home.csdnimg.cn/images/20210720083512.png)
![docx](https://img-home.csdnimg.cn/images/20210720083331.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)
![xlsm](https://img-home.csdnimg.cn/images/20210720083646.png)
![xlsm](https://img-home.csdnimg.cn/images/20210720083646.png)