工作表 1 具有三个表，它们具有相同的标题，由 1 行分隔。将每个表复制到新工作表中并将三个表合并为 1答案

【问题标题】：Sheet 1 has three tables with same headers separated by 1 row. Copy Every table into new sheet and merge three tables into 1工作表 1 具有三个表，它们具有相同的标题，由 1 行分隔。将每个表复制到新工作表中并将三个表合并为 1
【发布时间】：2017-09-15 16:22:31
【问题描述】：

大家好，我正在尝试使用 VBA 将来自网络的数据转储合并到 Excel 中的一个数据表中。数据转储的结构如附图所示：

4 个标题栏
3 个表，所有表都具有相同的标题
每个表之间都有几行空间。

我正在尝试做的事情：

将表头从第一个表复制到工作表 2
复制工作表 2 标题行下第一个表中的数据
将第二个表（不是标题行）中的数据复制到第一个表下的工作表 2
将第三个表（不是标题行）中的数据复制到第一个和第二个表下的工作表 2 中。

我卡在上面的#6 上。

For I = 2 To wb2.Sheets.Count
Sheets(I).Activate
Set OI1 = Range("A3:AM" & Range("A3").End(xlDown).Row)
OI1.Select
OI1Count = Selection.Rows.Count + 4
OI1.Copy Sheets("All Outstanding Invoices").Range("A" & 
Rows.Count).End(xlUp).Offset(1, 0)
Set OI1 = Nothing

Sheets(I).Activate
Set OI2 = Range("A3").Offset(OI1Count, 0)
OI2.Select

我想从第一个选定的表中偏移第一个表的大小 + 空行数，然后创建一个新范围来选择我的第二个表。但我不知道该怎么做。

 Set OI2 = Range("A3").Offset(OI1Count, 0)
OI2.Select

我需要的是类似的东西

 Set OI2 = Range("A3:AM").Offset(OI1Count,0)
 OI2.End(xlDown).Row

但这不起作用，我错过了什么？

【问题讨论】：

创建实际的数据表（VBA 中的列表对象）使您能够使用结构化引用，这将使代码更清晰:)
感谢您的反馈。对 VBA 来说是全新的：$ 到目前为止我创建的都是来自一些 Google Fu。你能指导我一些资源吗:)
现在我又读了一遍，数据转储总是以这种格式出现吗？是复制粘贴吗？还是你手动放置？还是通过代码来实现？
这是一个网站的 excel 摘录。数据格式总是这样（不知道为什么要这样设计）。为您提供一些背景信息，第一个表格显示延迟 >7 天的发票，第二个表格显示延迟

标签： vba excel

【解决方案1】：

为所有三个表（在您的示例中为三个）创建 Data Tables。您应该能够创建表格并仍然接收来自网站的摘录。

假设您分别将它们命名为 t1、t2 和 t3，那么您可以通过 VBA 以下列方式使用它们来完成您的任务：

Option Explicit

Sub ConsolidateTableData()

    Dim wsData As Worksheet
    Set wsData = Worksheets("ExtractData") 'change name as needed.

    Dim wsConsolidated As Worksheet
    Set wsConsolidated = Worksheets("ConsolidatedData") 'change as needed

    With wsData

        .ListObjects("t1").HeaderRowRange.Copy wsConsolidated.Range("A1")
        .ListObjects("t1").DataBodyRange.Copy wsConsolidated.Range("A" & Rows.Count).End(xlUp).Offset(1)
        .ListObjects("t2").DataBodyRange.Copy wsConsolidated.Range("A" & Rows.Count).End(xlUp).Offset(1)
        .ListObjects("t3").DataBodyRange.Copy wsConsolidated.Range("A" & Rows.Count).End(xlUp).Offset(1)

    End With

End Sub

更多信息请参见this。

【讨论】：

【解决方案2】：

使用区域更高效。

Sub test()
    Dim rng As Range, rngDB As Range, rngT As Range
    Dim Ws As Worksheet, toWs As Worksheet
    Dim vDB

    Set Ws = Sheets(1)
    Set toWs = Sheets(2)

    Set rngDB = Ws.Columns(1).SpecialCells(xlCellTypeConstants)
    toWs.UsedRange.Clear
    toWs.Range("a1").Resize(1, 4) = Ws.Range("a1").Resize(1, 4).Value

    For Each rng In rngDB.Areas
        vDB = rng.Range("a1").CurrentRegion.Offset(1)
        Set rngT = toWs.Range("a" & Rows.Count).End(xlUp)(2)
        rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
    Next rng

End Sub

【讨论】：