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

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
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
400
willow1985
willow1985
K
  • Question Question
Increasing row before the macro runs again
Replies
1
Views
230
kbk
K
Dazzawm
  • Solved
Change Range To Recorded Macro
Replies
3
Views
191
Alex Blakenburg
A
R
  • Question Question
I keep getting the error 91 but i cant figure out what is wrong here.
Replies
2
Views
60
mumps
mumps
D
  • Solved
Insert formula in last column macro
2
Replies
13
Views
215
MARK858
MARK858

Forum statistics

Threads
1,224,823
Messages
6,181,173
Members
453,021
Latest member
Justyna P

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