2017-12-03 154 views
0

因此我使用此代码,它太棒了。如果我可以得到一些线索如何调整它,所以它只会复制第一张从其拉出的工作簿。边注 - 请记住,并非每个工作簿的第一张纸都标题为“Sheet1”,其中一些名称已输入。如何将一个文件夹中的第一张工作簿复制到一个excel工作簿中

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 

回答

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 
+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 
相关问题