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

Question

So I'm using this code, and it is fantastic. If I can get some clues how to tweak it so it only copies the first sheet of the workbooks its pulling from. SIDE NOTE - Please keep in mind that not every workbook's first sheet is titled "Sheet1", some have names inputted.

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

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

Answer 2

You have all the parts and pieces here. I just got rid of the For Each loop.

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