将多个工作簿的第一页合并到一个工作簿中答案

【问题标题】：Combine first sheet of multiple workbooks into one workbook将多个工作簿的第一页合并到一个工作簿中
【发布时间】：2020-09-19 15:49:33
【问题描述】：

我有一个宏可以将不同的工作簿合并到一个主 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

如何将每个工作簿的第一个工作表仅包含到主工作簿中？

如何将工作表重命名为它来自的工作簿的名称？

【问题讨论】：

有几个字符在工作簿名称中有效但在工作表名称中无效（“[”和“]”），工作表名称限制为 31 个字符，而工作簿名称可以更长。因此，如果您尝试将工作表名称设置为等于工作簿名称，请为错误或其他意外行为做好准备。
好的，谢谢，如果我只想在不更改名称的情况下包含每个工作簿的表 1 和表 4？
查看user3598756的回答，只需在.Worksheets(1).Copy After:=ThisWorkbook.Sheets(1)之后添加一行.Worksheets(4).Copy After:=ThisWorkbook.Sheets(1)，同时删除ThisWorkbook.Sheets(2).name = .name这一行。
@Sner88，请坚持您当前的问题并走到最后。我发布了一个答案，如果它符合您的 original 问题，请接受它。如果出现不同的问题，请发布新帖子

标签： excel vba

【解决方案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

【讨论】：

感谢您的回复，但这不起作用。现在我得到第一个工作簿的第一个工作表，它将工作簿名称保存为第一个工作表名称。但是，我需要所有工作簿的第一张表，并将所有工作簿的第一张表重命名为工作簿本身的名称。你知道怎么做吗？也许更改每个语句？
代码不像您在评论中描述的那样工作。而是 1) 一个接一个地打开给定文件夹中的所有“.xls”类型工作簿 2) 仅将它们的第一个工作表复制到宏在其第一个工作表之后所在的工作簿中 3) 根据新插入的工作表重命名“源”工作簿名称。这实际上是你所要求的。我测试了它。你有吗？
@Sner88，你通过了吗？
不幸的是，.Worksheets(1).Copy After:=Thisworkbook.Sheets(1) 行将 ActiveWorkbook 更改为目标工作簿。然后导致ActiveWorkbook.Close 语句引用“主”工作簿。我认为最简单的解决方案是在With 块中包含.Close，并删除ActiveWorkbook.Close 语句。
@YowE3K，如果如您所说，它会关闭“ThisWorkbook”，即宏本身所在的工作簿，我会注意到...

【解决方案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

【讨论】：

看起来你没有正确地format你的代码块。您的意思是在代码块中包含第一行和最后一行吗？此外，不鼓励仅使用代码的答案。您应该解释这如何以及为什么会回答这个问题。