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

大家好，我尝试使用VBA从网络数据转储合并成一个单一的数据表格在Excel中。数据转储的结构类似于附图：

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

我想要做的事：

复制从所述第一表格中的报头插入到表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

但是，这并不工作，我缺少什么？

来源

2017-09-15 user2832803

创建实际的数据表（表中的VBA的对象），您可以使用结构化引用，这将使该代码有很多清洁:) –

感谢您的反馈意见。 VBA全新：$和我迄今为止创建的全部来自Google Fu。你能指导我一些资源:) – user2832803

现在我再次读到这一点，数据转储是否总是以这种格式？它是复制粘贴吗？或者你手动放置？或者你是通过代码来完成的吗？ –

为所有三个表格创建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。

来源

2017-09-15 18:10:58

使用区域更高效。

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

来源

2017-09-16 03:04:35

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

回答

相关问题