Simplify Recorded Macro

T

Timjan

Board Regular
Joined
Oct 5, 2016
Messages
63
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]


<colgroup><col style="mso-width-source:userset;mso-width-alt:33901;width:695pt" width="927"> </colgroup><tbody>
[TD="width: 927"]Any help would be appreciated.

<colgroup><col style="mso-width-source:userset;mso-width-alt:33901;width:695pt" width="927"> </colgroup><tbody>
[TD="width: 927"]Hi Dear Members,[/TD]
Thank you for your time and help.:)

</tbody>
[/TD]

</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

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
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.:laugh:
 
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
You must log in or register to reply here.

Similar threads

willow1985
  • Solved
VBA Run-time error 91 - Object variable or With block variable not set when trying to refresh data/Sleep
Replies
4
Views
280
willow1985
willow1985
K
  • Question Question
Increasing row before the macro runs again
Replies
1
Views
211
kbk
K
Dazzawm
  • Solved
Change Range To Recorded Macro
Replies
3
Views
152
Alex Blakenburg
A
brent3162
  • Solved
VBA help with increasing row before macro runs again.
Replies
3
Views
364
jolivanes
jolivanes
N
  • Question Question
Adding to an existing MACRO
Replies
2
Views
103
Northern NY Design
N

Forum statistics

Threads
1,223,896
Messages
6,175,265
Members
452,627
Latest member
KitkatToby

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