Vba 表1有三个表，标题相同，由一行分隔。将每个表复制到新工作表中，并将三个表合并为一个表

大家好，我正在尝试使用VBA将来自web的数据转储合并到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 

但那不行，我还缺什么

为所有三个表创建示例中的三个表。您应该能够创建表，并且仍然可以从网站接收摘录

假设您分别将它们命名为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

---

有关更多信息，请参阅。

使用区域更有效

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

---

在VBA中创建实际数据表和列表对象使您能够使用结构化引用，这将使代码更加清晰：感谢您的反馈。对VBA来说是全新的：$，而我迄今为止所创造的一切都来自于一些Google Fu。你能告诉我一些参考资料吗：现在我又读了一遍，数据转储是否总是采用这种格式？是复制粘贴吗？还是手动放置？或者你是通过代码来实现的？这是一个从网站上摘录的excel。数据格式总是这样，不知道为什么会这样设计。为了给您提供一些上下文信息，第一个表显示了延迟>7天的发票，第二个表显示了发票