VBA Loop Copying Horizontal Tables In A Vertical Format

[Angelos Voulgarakis]

Hi Guys,

I am quite new to VBA but i will thoroughly explain to you what I require. Any assistance possible will be much appreciated!

I have a worksheet named "Coupon Summary" which is my raw data page and a worksheet named "VERT.CPN.SUM" which is my input page and is blank at this moment

In "Coupon Summary", there are a growing amount of group horizontal (tables) of data with only 5 columns per group with a blank column in between each group

For Example.

Column A is A Generic Code Number
Column B is A Date
Column C is A Dollar Value
Column D is a Percentage
Column E is another date
Column F is Blank
And this format is repeated lets say infinite amount of times

Every Table has different amount of rows (data entries)

Row 1 is the headings but I want to offset this by one row just to grab all the raw data

Basically I want to copy all raw data (offset by 1 row as statement above) in Column A, Column A+6, Column (A+6)+6 + ..... + (A + 6) into VERT.CPN.SUM (A1) all under each other with no row spaces and the same with Column B, Column B+6, Column B+6+6 .... (B + 6) into (B1) etc etc.


Any help would be appreciate.

Ang.

 

[Luke M]

HI Angelos,

As VBA coding often has to be very specific in order to run correctly, would you mind posting your workbook, or at least an example of the layout and what you are wanting it to look like in finished product (a before and after layout)?

 

[Angelos Voulgarakis]

Hi Luke,

This is my code thus far

Sub mySub()
Dim wsSrc As Worksheet, wsDest As Worksheet
Dim iSrc As Integer, iDst As Integer, reference As Integer
 
iSrc = 1
Set wsSrc = Worksheets("Coupon Summary")
Set wsDest = Worksheets("VERT.CPN.SUM")
 
With wsSrc
Do Until .Cells(1, iSrc) = ""
 
iDst = wsDest.Cells(1, 1).CurrentRegion.Rows.Count + 1
.Range(.Cells(1, iSrc), .Cells(1, iSrc)).CurrentRegion.Copy _
Destination:=wsDest.Range(wsDest.Cells(iDst, 1), wsDest.Cells(iDst, 1))
Application.CutCopyMode = False
iSrc = iSrc + 6
Loop
 
End With
 
wsDest.Rows(1).Delete
 
End Sub

Please find attached the workbook as requested

The changes to this code is that I want in each table reference some of the 4th columns are BLANK and if there is data in the 5th column is doesn't show vertically once the macro is run

I also want to remove the headings in the VERT.CPN.SUM sheet thus start copy selection in Row 2 in Coupon Summary sheet and Paste in Row 2 VERT.CPN.SUM

Ill have my own headings in Row 1 of VERT.CPN.SUM

 

[Luke M]

Perfect, thanks. I believe this will do what you're looking for.

Sub mySub()
Dim wsSrc As Worksheet, wsDest As Worksheet
Dim lastRow As Long, lastCol As Long
Dim colCount As Long

Set wsSrc = Worksheets("Coupon Summary")
Set wsDest = Worksheets("VERT.CPN.SUM")

Application.ScreenUpdating = False

'Clear out previous data, if desired
wsDest.UsedRange.Offset(1).Clear

With wsSrc
    'Find where last column is
    lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
    'We want to increment our counter by 6
    For colCount = 1 To lastCol Step 6
        'Find we last row in current table is
        lastRow = .Cells(.Rows.Count, colCount).End(xlUp).Row
        'Now we're ready to copy each table
        .Cells(2, colCount).Resize(lastRow - 1, 5).Copy wsDest.Cells(.Rows.Count, "A").End(xlUp).Offset(1)
    Next colCount
End With
Application.ScreenUpdating = True

End Sub