所以我正在使用这个代码,这太棒了。如果我能得到一些线索如何调整它,所以它只复制它拉出的第一张工作簿。侧面注意 - 请记住,并非每个工作簿的第一张工作表都标题为“Sheet1”,有些已输入名称。
Sub MergeMultipleWorkbooks()
'Define Variables
Dim Path, FileName As String
'Assign Values to Variables
Path = Assign a Folder which contains excel files for example "C:\Merge\"
FileName = Dir(Path & "*.xlsx")
'Check FileName in the Given Location
Do While FileName <> ""
'Open Excel File
Workbooks.Open FileName:=Path & FileName, ReadOnly:=True
'Copy all the sheet to this workbook
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
'Close the ActiveWorkbook
Workbooks(FileName).Close
'Assign a Excel FileName
'Assign Next Excel FileName
FileName = Dir()
Loop
'Display a Message
MsgBox "Files has been copied Successfull", , "MergeMultipleExcelFiles"
End Sub
答案 0 :(得分:2)
Sub MergeMultipleWorkbooks()
Dim Path, FileName As String
Path = "C:\Merge\"
FileName = Dir(Path & "*.xlsx")
Do While FileName <> ""
With Workbooks.Open(FileName:=Path & FileName, ReadOnly:=True)
.Worksheets(1).Copy After:=ThisWorkbook.Sheets(1)
.Close False
End With
FileName = Dir()
Loop
MsgBox "Files has been copied Successfull", , "MergeMultipleExcelFiles"
End Sub
答案 1 :(得分:1)
这里有你所有的零件。我刚刚摆脱了For Each循环。
Sub MergeMultipleWorkbooks()
'Define Variables
Dim Path, FileName As String
'Assign Values to Variables
Path = "C:\Merge\"
FileName = Dir(Path & "*.xlsx")
'Check FileName in the Given Location
Do While FileName <> ""
'Open Excel File
Workbooks.Open FileName:=Path & FileName, ReadOnly:=True
'Copy the first sheet in file into this workbook
Sheets(1).Copy After:=ThisWorkbook.Sheets(1)
'Close the ActiveWorkbook
Workbooks(FileName).Close
'Assign Next Excel FileName
FileName = Dir()
Loop
'Display a Message
MsgBox "Files has been copied Successfully", , "MergeMultipleExcelFiles"
End Sub