VBA Copy a table and Paste it upside down

[Kiriko]

How can I write a VBA that will copy Table A and paste it as Table B (see below).

Please allow for Range Selection. Thanks for your suggestions.

Table A:

[TABLE="width: 201"]
<colgroup><col width="161" style="width: 121pt; mso-width-source: userset; mso-width-alt: 5888;"> <col width="107" style="width: 80pt; mso-width-source: userset; mso-width-alt: 3913;"> <tbody>[TR]
[TD="width: 161, bgcolor: transparent"]Category[/TD]
[TD="width: 107, bgcolor: transparent"] Total Spend [/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Merchandise[/TD]
[TD="bgcolor: transparent"] 5,642,042.62 [/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Corporate Services [/TD]
[TD="bgcolor: transparent"] 9,054,819.94 [/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Travel & Accommodation[/TD]
[TD="bgcolor: transparent"] 11,304,167.05 [/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Support Costs[/TD]
[TD="bgcolor: transparent"] 61,560,281.01 [/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Support Services[/TD]
[TD="bgcolor: transparent"] 95,534,059.06 [/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Business Technology[/TD]
[TD="bgcolor: transparent"] 119,109,991.04
[/TD]
[/TR]
</tbody>[/TABLE]

Table B:

[TABLE="width: 201"]
<colgroup><col width="161" style="width: 121pt; mso-width-source: userset; mso-width-alt: 5888;"> <col width="107" style="width: 80pt; mso-width-source: userset; mso-width-alt: 3913;"> <tbody>[TR]
[TD="width: 161, bgcolor: transparent"]Category[/TD]
[TD="width: 107, bgcolor: transparent"] Total Spend [/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Business Technology[/TD]
[TD="bgcolor: transparent"] 119,109,991.04 [/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Support Services[/TD]
[TD="bgcolor: transparent"] 95,534,059.06 [/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Support Costs[/TD]
[TD="bgcolor: transparent"] 61,560,281.01 [/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Travel & Accommodation[/TD]
[TD="bgcolor: transparent"] 11,304,167.05 [/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Corporate Services [/TD]
[TD="bgcolor: transparent"] 9,054,819.94 [/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Merchandise[/TD]
[TD="bgcolor: transparent"] 5,642,042.62 [/TD]
[/TR]
</tbody>[/TABLE]

 

[JustynaMK]

Hi Kiriko,

Try using the following code:

Sub CopyTable()
    With Sheet1
        .Range("[COLOR=#0000ff]A11:B17[/COLOR]").Value = .Range("[COLOR=#ff0000]A1:B7[/COLOR]").Value
        With .Sort
            .SetRange Range("[COLOR=#0000ff]A11:B17[/COLOR]")
            .Orientation = xlTopToBottom
            .Apply
        End With
    End With
End Sub

This one copies values from cells A1:B7 to A11:B17 and sorts values ("Total Spend") from largest to smallest.

 

[Kiriko]

Hi Justyna, thank you for this code, however I was hoping to incorporate Set WorkRng into it somehow. See, I have to copy paste a number of tables on the same spreadsheet, and while they have only 2 columns the number of rows varies... would this be possible to do

 

[JustynaMK]

Hey Kiriko,

Before I adjust my code, could you please clarify a few more things for me:
a) in VBA code, would you like to set your own array of ranges, e.g. ("A1:B7", "D1:E8", "H1:I9") and loop through each range? The potential disadvantage might be that if you ever add new data to your tables, the ranges in your VBA won't change automatically and you'd need to adjust VBA code manually.
b) alternatively, you could create Named Ranges in your Excel file (one for each table) and we will loop through these Names in VBA code. The advantage is that these will expand automatically in case you change your dataset.
c) third solution is to simply loop through all tables in your Excel sheet, so you don't even need to provide any range references. However, this will include all tables, without any exceptions.

The second important part is where exactly you want to paste these tables - is it, let's say, offset 2 rows below your original table? Or perhaps all these tables should be copied to row 50?

Let me know if anything is unclear.

 

[Kiriko]

Hi Justyna,

I think in this case option B is the best. And I would only need to paste a few rows below so max 3 rows below original table...

 

[JustynaMK]

Thank you Kiriko, it's all clear now. Please try using the following code:

Sub CopyTable()
    Dim WorkRng()           As Variant
    Dim varRng              As Variant
    Dim lngCount            As Long


[COLOR=#ff0000]    WorkRng = Array("rng_Table1", "rng_Table2", "rng_Table3")[/COLOR]


    With Sheet1
        For Each varRng In WorkRng
            lngCount = Range(varRng).Rows.Count
            .Range(varRng).Offset(lngCount + 3, 0).Value = .Range(varRng).Value
            .Range(varRng).Offset(lngCount + 3, 0).Sort _
                Key1:=Cells(lngCount + 3, Range(varRng).Column + 1), _
                Order1:=xlAscending, _
                Header:=xlYes
        Next varRng
    End With
End Sub

I am assuming that you want to paste all your tables 3 rows below the original ones and sort each one of them by the second column ("Total Spend").
I have highlighted the line which you need to modify with your selection of Named Ranges.