CODEWITHSUNDEEP
vbaexcel
user2832803
user2832803

Reputation: 33

Sheet 1 has three tables with same headers separated by 1 row. Copy Every table into new sheet and merge three tables into 1

enter image description here

Hi Everyone, I'm trying to merge a data dump from the web into one single data table in Excel using VBA. The data dump is structured like the picture attached:

  1. 4 Header Columns
  2. 3 tables, all with the same headers
  3. Between every table there are a few rows of space.

What I'm trying to do:

  1. Copy the header from the first table into Sheet 2
  2. Copy the data from the first table under the header row in Sheet 2
  3. Copy data from second table (not the header row) into Sheet 2 under the first table
  4. Copy data from third table (not the header row) into Sheet 2 under the first and second table.

I'm getting stuck on #6 above. 

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

I want to offset from first selected table by the size of the first table + the number of empty rows, then create a new range which would select my second table. But i'm stuck on how to do that.

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

What i need is for something like 

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

But that doesn't work, what am I missing?

Upvotes: 1

Views: 346

Answers (2)

Dy.Lee
Dy.Lee

Reputation: 7567

Using Area is more efficient.

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

Upvotes: 0

Scott Holtzman
Scott Holtzman

Reputation: 27269

Create Data Tables for all three tables (three in your example). You should be able to create the tables and still receive the extract from the website.

Assuming you name them t1, t2 and t3, respectively, you can then work with them through VBA in the following way to accomplish your task:

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

See this for more information.

Upvotes: 1

Related Questions