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

Question

大家好，我尝试使用VBA将来自网络的数据转储合并到Excel中的单个数据表中。 数据转储的结构类似于附图：

1. 4个标题栏
2. 3个表，所有表格都相同
3. 在每张桌子之间都有几排空间。

我想做的事情：

1. 将第一个表格中的标题复制到第2页
2. 复制工作表2
中标题行下第一个表格中的数据
3. 将第二个表（不是标题行）中的数据复制到第一个表
下的表2中
4. 将数据从第三个表（不是标题行）复制到第一个和第二个表下的表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 

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

Answer 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。

Answer 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