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

时间:2017-12-03 02:58:10

标签: excel vba

所以我正在使用这个代码,这太棒了。如果我能得到一些线索如何调整它,所以它只复制它拉出的第一张工作簿。侧面注意 - 请记住,并非每个工作簿的第一张工作表都标题为“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

2 个答案:

答案 0 :(得分: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

答案 1 :(得分: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