Simplify Recorded Macro

T

Timjan

Board Regular
Joined
Oct 5, 2016
Messages
63
Hi Dear Members,
I have a workbook with ten sheets, one of which is a Total Sheet. I need to extract data from at least eight sheets all from the same range and append it
in the Total Sheet to a different range. I have recorded a macro for one sheet so far but, It does not include Copying to the last row of each required
column in each of the sheets. The Recorded Macro is very basic and cumbersome, and I would like to know if any one would please be so kind as to
guide me in how to shorten the Code. Sample for one sheet shown below. How do I get it short and sweet with all of the other remaining seven
sheets included, and can it be done with the Sheet Index number, or does it have to be via the sheet name?:confused:

Code: 
  [TABLE]
<colgroup><col style="mso-width-source:userset;mso-width-alt:33901;width:695pt" width="927">  </colgroup><tbody>[TR]
   [TD="class: xl65, width: 927"]' Macro1   Macro[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]'[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"][/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]'[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Sheets("Oos").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Range("Z13:Z15").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Selection.Copy[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Sheets("Totals").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Range("B14").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,   SkipBlanks _[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]         :=False, Transpose:=False[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Application.CutCopyMode = False[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Range("D14").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Sheets("Oos").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     ActiveWindow.ScrollColumn = 1[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Range("B13:D15").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Selection.Copy[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Sheets("Totals").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,   SkipBlanks _[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]         :=False, Transpose:=False[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Sheets("Oos").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Range("N13:N15").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Application.CutCopyMode = False[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Selection.Copy[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Sheets("Totals").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Range("J14").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,   SkipBlanks _[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]         :=False, Transpose:=False[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Sheets("Oos").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Range("T13:T15").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Application.CutCopyMode = False[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Selection.Copy[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Sheets("Totals").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Range("P14").Select[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,   SkipBlanks _[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]         :=False, Transpose:=False[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]     Application.CutCopyMode = False[/TD]
  [/TR]
  [TR]
   [TD="class: xl65, width: 927"]End Sub[/TD]
  [/TR]
 </tbody>[/TABLE]

Any help would be appreciated.
Thank you for your time and help.:)

<colgroup><col style="mso-width-source:userset;mso-width-alt:33901;width:695pt" width="927"> </colgroup><tbody>
</tbody>

<colgroup><col style="mso-width-source:userset;mso-width-alt:33901;width:695pt" width="927"> </colgroup><tbody>
</tbody>
 
Sort by date Sort by votes
It looks like Fluff is offline but it seems all you need to do is make the changes in red below.

Code: 
Sub Timjan()
   Dim UsdRws As Long, NxtRw As Long, i As Long
   
   For i = [COLOR="#FF0000"]3[/COLOR] To [COLOR="#FF0000"]9[/COLOR]
      With Sheets("[COLOR="#FF0000"]Region[/COLOR]" & i)
         UsdRws = .Range("S" & Rows.Count).End(xlUp).Row
         NxtRw = Sheets("Totals").Range("B" & Rows.Count).End(xlUp).Row
         Sheets("Totals").Range("B" & NxtRw).Resize(UsdRws - 12).Value = .Range("Z13:Z" & UsdRws).Value
         Sheets("Totals").Range("D" & NxtRw).Resize(UsdRws - 12).Value = .Range("B13:D" & UsdRws).Value
         Sheets("Totals").Range("J" & NxtRw).Resize(UsdRws - 12).Value = .Range("N13:N" & UsdRws).Value
         Sheets("Totals").Range("P" & NxtRw).Resize(UsdRws - 12).Value = .Range("T13:T" & UsdRws).Value
      End With
   Next i
End Sub
 
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Thank you MARK858,

That seems quite logical, Thank you.

Just out of curiosity, what if all those sheet names change to, for example; "Three", "Four", "Five", "Six", "Seven", "Eight" and "Nine"?

Would it be possible to amend Fluff's Code to cater for that?

Thank you your help!
 
Upvote 0
Not in the same way, you would have to make an array of the sheet names then loop through that rather than use an index like we are in Fluff's current code.
 
Upvote 0
Thank you MARK858,

I will see if Google can help me with a sample of your suggestion. and if I find nothing, I will be back to ask you guys for help.:LOL:
 
Upvote 0
Didn't post an example because it isn't your current situation but if you want examples see 2 ways below...

Code: 
Sub Test1()
    Dim UsdRws As Long, NxtRw As Long
    Dim shtNames, iArr As Long

    shtNames = Array("Three", "Four", "Five", "Six", "Seven", "Eight", "Nine")
    Application.ScreenUpdating = False

    For iArr = LBound(shtNames) To UBound(shtNames)
        On Error Resume Next

        With Worksheets(shtNames(iArr))
            UsdRws = .Range("S" & Rows.Count).End(xlUp).Row
            NxtRw = Sheets("Totals").Range("B" & Rows.Count).End(xlUp).Row
            Sheets("Totals").Range("B" & NxtRw).Resize(UsdRws - 12).Value = .Range("Z13:Z" & UsdRws).Value
            Sheets("Totals").Range("D" & NxtRw).Resize(UsdRws - 12).Value = .Range("B13:D" & UsdRws).Value
            Sheets("Totals").Range("J" & NxtRw).Resize(UsdRws - 12).Value = .Range("N13:N" & UsdRws).Value
            Sheets("Totals").Range("P" & NxtRw).Resize(UsdRws - 12).Value = .Range("T13:T" & UsdRws).Value
        End With
        On Error GoTo 0
    Next
    Application.ScreenUpdating = True
End Sub

Code: 
Sub Test2()
    Dim UsdRws As Long, NxtRw As Long
    Dim shtNames, shtCnt

    shtNames = Array("Three", "Four", "Five", "Six", "Seven", "Eight", "Nine")
    Application.ScreenUpdating = False

    For Each shtCnt In shtNames
        On Error Resume Next

        With Worksheets(shtCnt)
            UsdRws = .Range("S" & Rows.Count).End(xlUp).Row
            NxtRw = Sheets("Totals").Range("B" & Rows.Count).End(xlUp).Row
            Sheets("Totals").Range("B" & NxtRw).Resize(UsdRws - 12).Value = .Range("Z13:Z" & UsdRws).Value
            Sheets("Totals").Range("D" & NxtRw).Resize(UsdRws - 12).Value = .Range("B13:D" & UsdRws).Value
            Sheets("Totals").Range("J" & NxtRw).Resize(UsdRws - 12).Value = .Range("N13:N" & UsdRws).Value
            Sheets("Totals").Range("P" & NxtRw).Resize(UsdRws - 12).Value = .Range("T13:T" & UsdRws).Value
        End With

        On Error GoTo 0
    Next shtCnt

    Application.ScreenUpdating = True

End Sub
 
Last edited:
Upvote 0
Hello good fellas,

MARK858, None of your sample codes want to work. In fact, it does nothing. Might it be that you are Coding in Excel 2016 which Excel 2010 cannot read?:confused:
 
Upvote 0
I have just ran the code below with sheets named "Three", "Four" and "Five" and the code runs as expected.....

Code: 
Sub Test2a()
    Dim UsdRws As Long, NxtRw As Long, i As Long
    Dim shtNames, shtCnt

    shtNames = Array("Three", "Four", "Five", "Six", "Seven", "Eight", "Nine")
    Application.ScreenUpdating = False
    i = 3
    For Each shtCnt In shtNames
        On Error Resume Next

        With Worksheets(shtCnt)
            .Cells(2, 2) = i
        
        End With
        i = i + 1
        On Error GoTo 0
    Next shtCnt

    Application.ScreenUpdating = True

End Sub


and it works fine in 2010 as there is nothing new in the code.

Edit: and the below works fine as well

Code: 
Sub Test5()
    Dim UsdRws As Long, NxtRw As Long, i As Long
    Dim shtNames, iArr As Long

    shtNames = Array("Three", "Four", "Five", "Six", "Seven", "Eight", "Nine")
    Application.ScreenUpdating = False
    i = 8
    For iArr = LBound(shtNames) To UBound(shtNames)
        On Error Resume Next

        With Worksheets(shtNames(iArr))
            .Cells(2, 2) = i
        
        End With
      i = i + 1
        On Error GoTo 0
    Next

End Sub
 
Last edited:
Upvote 0
@Timjan, are you sure that your sheets you tried the codes on are named "Three", "Four", "Five", "Six", "Seven", "Eight" and "Nine" and not "Region Three", "Region Four", "Region Five", "Region Six", "Region Seven", "Region Eight" and "Region Nine"?
 
Upvote 0
Or are they named 3,4,5 etc?
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
97
myall_blues
myall_blues
C
  • Solved
Please help me clean up my VBA script, I'm having trouble with redundancies
Replies
4
Views
122
CapRavOr
C
P
  • Solved
Counter in For Each loop
Replies
2
Views
242
Possum17
P
A
  • Question
Macro to update list to last row on another sheet copy source from multiple sheets
Replies
0
Views
327
Azamamir
A
P
  • Solved
Need help with macro Dynamic Range??
Replies
6
Views
229
pennbowl
P

Forum statistics

Threads
1,215,825
Messages
6,127,112
Members
449,359
Latest member
michael2

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top