如何將一個文件夾中的第一張工作簿複製到一個excel工作簿中

Question

因此我使用此代碼，它太棒了。如果我可以得到一些線索如何調整它，所以它只會複製第一張從其拉出的工作簿。邊注 - 請記住，並非每個工作簿的第一張紙都標題爲「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 

Answer 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 

Answer 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