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