簡體   English   中英

如何僅將文件夾中的第一批工作簿復制到一個Excel工作簿中

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

所以我正在使用此代碼,這太棒了。 如果我能找到一些有關如何進行調整的線索,那么它僅復制其工作表的第一頁。 旁注-請記住,並非每個工作簿的第一張工作表都標題為“ 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
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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM