将多个工作簿的第一张表合并为一个工作簿

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