☰

将多张工作表中的表格合并到一张工作表中

tag-icon • tag-icon microsoft-excel microsoft-excel-2007
将多张工作表中的表格合并到一张工作表中

我有一个包含 30 多张工作表的 Excel 文档。每张工作表的布局都相同：一个简单的表格，其中包含相同的列、标题/总行数，但行数不同（没有一张超过 500 行）。

我想将它们合并到主表中。仅需一次操作。

手动地，我可以在新的工作表上一个接一个地复制 30 个表格。完成后，我会进行排序并删除任何空白/标题/总计行。我不关心格式。我猜这大概需要 15-20 分钟，但总是存在犯错和错过工作表或其他东西的风险。

VBA 听起来会花费太多时间。现在我几乎正在考虑将工作簿导入 SQL Server，将它们合并，然后将结果复制粘贴回 Excel。

你有什么好办法吗？

答案1

如果您需要经常这样做，那么我建议您编写一个快速的 VBA 例程。如果这是一次性的事情，那么我会手动执行。为了确保您不会意外跳过表格，请使用剪切粘贴而不是复制粘贴。

以下是我的做法。使用键盘快捷键可以快速完成。

  • 以只读方式打开 Excel 中的原始工作簿，以防止任何意外数据丢失。
  • 打开一个新工作簿来保存新的主表。
  • 关闭所有其他工作簿，以便您可以轻松地在正在使用的两个工作簿之间切换。
  • 选择要复制的原始工作簿中的第一个工作表。

现在您可以开始使用键盘快捷键。

  1. Ctrl + Home跳转到电子表格的左上角。（除非有行或列冻结，否则将跳转到 A1。）
  2. Shift + Ctrl + End选择当前选定单元格左侧及下方的所有内容。
  3. Ctrl + X剪切数据。
  4. Ctrl + Tab切换到新的工作簿。
  5. 仔细检查您是否在正确的位置并按下Enter以粘贴数据。
  6. Ctrl + End转到最后粘贴的单元格。
  7. Down Arrow转到下一个未使用的行。
  8. Ctrl + Left Arrow返回 A 列。
  9. Ctrl + Tab切换回原始工作簿。
  10. Ctrl + Page Down选择下一个工作表。
  11. 回到步骤 1 并重复，直到完成。

完成后，您可以Ctrl + Page Up返回所有原始工作表并验证所有数据是否已被删除。

假设您的标题行未冻结，这将从所有 30 个表中复制标题行。在这种情况下，要么对主表进行排序以将所有重复的标题行分组并删除多余的行，要么使用数据 -> 删除重复项。

如果您不小心跳过了某个步骤或者粘贴了现有数据，请Ctrl + Z按撤消。

我刚刚按照上述步骤进行了测试。我使用的工作簿有 10 个工作表，每个工作表有 120 行数据。我花了 1 分半钟创建主表。如果您不熟悉键盘快捷键，则可能需要两倍的时间。对于 30 个工作表，我猜可能需要 10 分钟。

答案2

我添加了同样的问题，在这里发现了一个很棒的宏： http://excel.tips.net/T003005_Condensing_Multiple_Worksheets_Into_One.html

Sub Combine()
    Dim J As Integer

    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add ' add a sheet in first place
    Sheets(1).Name = "Combined"

    ' copy headings
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")

    ' work through sheets
    For J = 2 To Sheets.Count ' from sheet 2 to last sheet
        Sheets(J).Activate ' make the sheet active
        Range("A1").Select
        Selection.CurrentRegion.Select ' select all cells in this sheets

        ' select all lines except title
        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

        ' copy cells selected in the new sheet on last line
        Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
    Next
End Sub

只需复制粘贴宏，运行它就完成了！

相关内容