简体   繁体   中英

How to copy only the first sheets of workbooks in a folder into one excel workbook

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
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

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM