多个工作簿都具有相同的模板表/选项卡,其中标记为 A,并包含其他选项卡。我可以快速将所有标记为 A 的选项卡放到一个工作簿上吗?(就像 power query 如何合并/附加不同工作簿中的同一张表一样)。
谢谢。
答案1
尝试以下宏:
Sub CombineWorkbooks()
'Declare variables
Dim Path As String, FileName As String
Dim wkb As Workbook, wkbNew As Workbook
Dim wks As Worksheet, wksNew As Worksheet
Dim FolderPath As String
Dim FilesInFolder As Variant
Dim i As Integer
'Turn off screen updating to speed up code execution
Application.ScreenUpdating = False
'Set the path to the folder containing the workbooks
FolderPath = "C:\Your\Folder\Path\"
'Get all files in the folder
FilesInFolder = Dir(FolderPath & "*.xlsx")
'Create a new workbook to copy the sheets to
Set wkbNew = Workbooks.Add
'Loop through all files in the folder
Do While FilesInFolder <> ""
'Open the workbook
Set wkb = Workbooks.Open(FolderPath & FilesInFolder)
'Loop through all sheets in the workbook
For Each wks In wkb.Sheets
'Check if the sheet is named "A"
If wks.Name = "A" Then
'Copy the sheet to the new workbook
wks.Copy After:=wkbNew.Sheets(wkbNew.Sheets.Count)
Set wksNew = wkbNew.Sheets(wkbNew.Sheets.Count)
'Rename the sheet to the original workbook name
wksNew.Name = wkb.Name
'Close the original workbook without saving changes
wkb.Close False
End If
Next wks
'Get the next file in the folder
FilesInFolder = Dir
Loop
'Save and close the new workbook
wkbNew.SaveAs FolderPath & "CombinedSheets.xlsx"
wkbNew.Close
'Turn on screen updating
Application.ScreenUpdating = True
'Notify user that the code has finished running
MsgBox "Done!"
End Sub