如何使用Excel中的VBA將工作簿中的單個選項卡複製到主工作簿中

Question

我試圖將一個選項卡從指定文件夾中的許多工作簿拉入主工作簿。到目前爲止，這是我所：

Sub GetSheets() 
Path = "D:\APQP\APQP\Open Projects\" 
Filename = Dir(Path & "*.xlsx") 
    Do While Filename <> "" 
    Workbooks.Open Filename:=Path & Filename, ReadOnly:=True 
    For Each Sheet In ActiveWorkbook.Sheets 
    Sheets("5-Phase").Select 
    Sheets("5-Phase").Copy Before:=ThisWorkbook.Sheets(1) 
    Next 
    Workbooks(Filename).Close 
    Filename = Dir() 
    Loop 
End Sub 

現在，當我運行它，它填充主簿與標籤50從文件夾中的第一wookbook，而不是應對的標籤和移動到下一個工作簿和應對該工作簿中的選項卡。任何幫助都會很棒。

Answer 1

您的代碼有兩個主要問題。 For循環是不必要的，並且您沒有使用打開的工作簿。像這樣的東西應該爲你工作：

Sub GetSheets() 

    Dim wb As Workbook 
    Dim sPath As String 
    Dim sFileName As String 

    Set wb = ThisWorkbook 
    sPath = "D:\APQP\APQP\Open Projects\" 
    sFileName = Dir(sPath & "*.xlsx") 

    Application.ScreenUpdating = False 
    Application.EnableEvents = False 

    On Error Resume Next 
    Do While Len(sFileName) > 0 
     With Workbooks.Open(sPath & sFileName, ReadOnly:=True) 
      .Sheets("5-Phase").Copy Before:=wb.Sheets(1) 
      .Close False 
     End With 
     sFileName = Dir() 
    Loop 
    On Error GoTo 0 

    Application.ScreenUpdating = True 
    Application.EnableEvents = True 

End Sub