Copy Ranges from multiple worksheets and combine into one worksheet

[Tabanag]

I tried to search for a macro I could use but I'm not good at revising what's already available. I would like to:

- Copy the same range ("A43:I53") from 31 worksheets (named: 01, 02, 03 ... 31) onto a worksheet named "Misc" starting from cell A9. Headers in row 1-8.
- After this is done, sort the data by column H, then by column C.
- If at all possible, create a formula at the bottom of column G to sum the column.

My data looks like:

Col A Col B Col C Col D Col E Col F Col G Col H Col I
Candy Smith 4/12 Cash COD Taxed 1000 25.00 None


This is a task that's done monthly so would appreciate any help please!

Thank you so much in advance!

 

[AlphaFrog]

[color=darkblue]Sub[/color] Misc()
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color], r [color=darkblue]As[/color] Long
    r = 9
    [color=darkblue]With[/color] Sheets("Misc")
        [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] 3
            .Range("A" & r).Resize(11, 9).Value = _
                Worksheets(Format(i, "00")).Range("A43:I53").Value
            r = r + 11
        [color=darkblue]Next[/color] i
        .Range("A9:I350").Sort Key1:=.Range("H9"), Order1:=xlAscending, Header:=xlNo
        .Range("A9:I350").Sort Key1:=.Range("C9"), Order1:=xlAscending, Header:=xlNo
        .Range("G351").Formula = "=SUM(G9:G350)"
    [color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[AlphaFrog]

EDIT: This line should be

[COLOR=darkblue]For[/COLOR] i = 1 [COLOR=darkblue]To[/COLOR] [COLOR="#FF0000"]31[/COLOR]

 

[Tabanag]

[color=darkblue]Sub[/color] Misc()
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color], r [color=darkblue]As[/color] Long
    r = 9
    [color=darkblue]With[/color] Sheets("Misc")
        [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] 3
            .Range("A" & r).Resize(11, 9).Value = _
                Worksheets(Format(i, "00")).Range("A43:I53").Value
            r = r + 11
        [color=darkblue]Next[/color] i
        .Range("A9:I350").Sort Key1:=.Range("H9"), Order1:=xlAscending, Header:=xlNo
        .Range("A9:I350").Sort Key1:=.Range("C9"), Order1:=xlAscending, Header:=xlNo
        .Range("G351").Formula = "=SUM(G9:G350)"
    [color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

Hi AlphaFrog!

Works Perfect!!! I got the combined data into the "Misc" worksheet so perfectly! In No Time! In a blink of an eye!

And Thank You for the quick response!

Thank you so much again! Will save us tons to time!

Tabanag

 

[AlphaFrog]

You're welcome. Thanks for the feedback.

 

[Tabanag]

Hi AlphaFrog,

Would I be able to somewhat re-use this macro on another workbook?

This time, I would like to copy the ranges "B5:B100" from 5 worksheets named:
1-ORM
2-MRM
3-IRM
4-PIPE
5-MAUISAND

.. to be combined onto a worksheet named "Sheet6" starting in row "A". Will need to also sort this. And this time, will need to delete duplicates.

Just to note that there are other worksheets in this workbook that will not be included in this macro.

Can't thank you enough!

Tabanag

 

[AlphaFrog]

Wasn't sure if the sheet names included the leading numbers or not. Edit the names in the code to suit.
Edit the four 9s to the starting row number to paste to

[COLOR=darkblue]Sub[/COLOR] Sheet6()
    [COLOR=darkblue]Dim[/COLOR] ws [COLOR=darkblue]As[/COLOR] Worksheet, r [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    r = [COLOR=#ff0000]9[/COLOR]   [COLOR=green]'Start row to paste to[/COLOR]
    [COLOR=darkblue]With[/COLOR] Sheets("Sheet6")
        [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] ws [COLOR=darkblue]In[/COLOR] Sheets(Array([COLOR=#b22222]"1-ORM", "2-MRM", "3-IRM", "4-PIPE", "5-MAUISAND"[/COLOR]))
            .Range("A" & r).Resize(96, 1).Value = ws.Range("B5:B100").Value
            r = r + 96
        [COLOR=darkblue]Next[/COLOR] ws
        .Range("A[COLOR=#ff0000]9[/COLOR]:A" & (r - 1)).Sort Key1:=.Range("A[COLOR=#ff0000]9[/COLOR]"), Order1:=xlAscending, Header:=xlNo
        .Range("A[COLOR=#ff0000]9[/COLOR]:A" & (r - 1)).RemoveDuplicates Columns:=Array(1), Header:=xlNo
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[Tabanag]

Wasn't sure if the sheet names included the leading numbers or not. Edit the names in the code to suit.
Edit the four 9s to the starting row number to paste to

[COLOR=darkblue]Sub[/COLOR] Sheet6()
    [COLOR=darkblue]Dim[/COLOR] ws [COLOR=darkblue]As[/COLOR] Worksheet, r [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    r = [COLOR=#ff0000]9[/COLOR]   [COLOR=green]'Start row to paste to[/COLOR]
    [COLOR=darkblue]With[/COLOR] Sheets("Sheet6")
        [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] ws [COLOR=darkblue]In[/COLOR] Sheets(Array([COLOR=#b22222]"1-ORM", "2-MRM", "3-IRM", "4-PIPE", "5-MAUISAND"[/COLOR]))
            .Range("A" & r).Resize(96, 1).Value = ws.Range("B5:B100").Value
            r = r + 96
        [COLOR=darkblue]Next[/COLOR] ws
        .Range("A[COLOR=#ff0000]9[/COLOR]:A" & (r - 1)).Sort Key1:=.Range("A[COLOR=#ff0000]9[/COLOR]"), Order1:=xlAscending, Header:=xlNo
        .Range("A[COLOR=#ff0000]9[/COLOR]:A" & (r - 1)).RemoveDuplicates Columns:=Array(1), Header:=xlNo
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Hi AlphaFrog,

Yes!!! Worked exactly as needed to! It is like magic!

Can't thank you enough for saving me tons of time and work! Thank you for this forum!

Wish I could be as awe inspiring!

Tabanag