將多個工作簿的第一張表合並為一個工作簿

Question

我有一個宏可以將不同的工作簿組合成一個主 Excel 工作簿：

Sub GetSheets()
Path = "\Users\myname\Documenten\Test\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
    Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
        For Each Sheet In ActiveWorkbook.Sheets
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
        Next Sheet
    Workbooks(Filename).Close
    Filename = Dir()
Loop
End Sub

我如何將每個工作簿的第一個工作表僅包含到主工作簿中？

我如何將工作表重命名為它來自的工作簿的名稱？

Answer 1

試試這個：

Option Explicit

Sub GetSheets()
    Dim Path As String, fileName As String
    Dim Sht As Worksheet

    Path = "\Users\myname\Documenten\Test\"
    fileName = Dir(Path & "*.xls")
    Do While fileName <> ""
        Workbooks.Open fileName:=Path & fileName, ReadOnly:=True
        With ActiveWorkbook
            .Worksheets(1).Copy After:=ThisWorkbook.Sheets(1)
            ThisWorkbook.Sheets(2).name = .name
        End With
        ActiveWorkbook.Close
        fileName = Dir()
    Loop
End Sub

Answer 2

Sub GetSheets()
Dim Path As String, fileName As String
Dim Sht As Worksheet

Path = "\somepath\"
fileName = Dir(Path & "*.xls")
Do While fileName <> ""
    Workbooks.Open fileName:=Path & fileName, ReadOnly:=True
    With ActiveWorkbook
        .Worksheets(1).Copy After:=ThisWorkbook.Sheets(1)
    End With
 Workbooks(fileName).Close
    fileName = Dir()
Loop
End Sub