如何将一个文件夹中的第一张工作簿复制到一个Excel工作簿中

所以我使用这个代码,它太棒了。 如果我能得到一些线索如何调整,所以它只能复制其拉出的第一张工作簿。 边注 – 请记住,并非每个工作簿的第一张纸都标题为“Sheet1”,有些已经input了名字。

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 

 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 

你在这里有所有的零件。 我刚刚摆脱了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