使用VBA或宏將Sheet1從多個工作簿中的數據從特定文件夾導入單個工作簿

Question

使用VBA或宏從多個工作簿中將Sheet1數據提取到單個工作簿中

Option Explicit
Sub MergeExcels()

    Dim Path As String, FName As String
    Dim wb As Workbook
    Dim ws As Worksheet

    Path = ""
    FName = Dir(Path & "*.xlsx")
    With ThisWorkbook
        Do While FName <> ""
            Set wb = Workbooks.Open(Path & FName, ReadOnly:=True)
            For Each ws In wb.Worksheets
                ws.Copy After:=.Sheets(.Sheets.Count)
            Next ws
            wb.Close SaveChanges:=False
            FName = Dir()
        Loop
    End With

End Sub

上面的代碼獲取工作簿中的所有表但我只需要Sheet1數據

Answer 1

更改：

For Each ws In wb.Worksheets
    ws.Copy After:=.Sheets(.Sheets.Count)
Next ws

至：

wb.Worksheets("Sheet1").Copy After:=.Sheets(.Sheets.Count)

或者，如果您的意思是第一個工作表而不是名為Sheet1的工作表：

wb.Worksheets(1).Copy After:=.Sheets(.Sheets.Count)

Answer 2

Option Explicit
Sub MergeExcels()
    Dim Path As String, FName As String
    Dim wb As Workbook
    Dim ws As Worksheet

    Path = "D:\BILL'S\Thankam\2019\June\Bills"
    FName = Dir(Path & "*.xlsx")
    With ThisWorkbook
        Do While FName <> ""
            Set wb = Workbooks.Open(Path & FName, ReadOnly:=True)
            wb.Worksheets("Sheet1").Copy After:=.Sheets(.Sheets.Count)
            wb.Close SaveChanges:=False
            FName = Dir()
        Loop
    End With
End Sub

Answer 3

Option Explicit Sub MergeExcels（）

Dim Path As String, FName As String
Dim wb As Workbook
Dim ws As Worksheet

Path = "D:\BILL'S\Thankam\2019\June\Bills"
FName = Dir(Path & "*.xlsx")
With ThisWorkbook
    Do While FName <> ""
        Set wb = Workbooks.Open(Path & FName, ReadOnly:=True)
        wb.Worksheets(1).Copy After:=.Sheets(.Sheets.Count)
        wb.Close SaveChanges:=False
        FName = Dir()
    Loop
    End With

結束子