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

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

1. 4个标题列
2. 3个表格，全部具有相同的标题
3. 每张桌子之间都有几排空间。

我在做什么：

4. 将第一个表中的标题复制到Sheet 2中
5. 复制来自第2页的标题行下的第一个表的数据
6. 将第二个表格（不是标题行）中的数据复制到第一个表格下的Sheet 2中
7. 将第三个表格（不是标题行）的数据复制到第一个和第二个表格下的Sheet 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 

我想从第一个表的大小第一个选定的表中偏移+空行的数量，然后创build一个新的范围，将select我的第二个表。 但我坚持如何做到这一点。

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

我需要的是类似的东西

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

但是这不行，我错过了什么？

Answer 1

为所有三个表创build数据表 （在你的例子中是三个）。 您应该能够创build表格，并仍然从网站接收摘录。

假设你分别命名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 

看到这个更多的信息。

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