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
@MARK858,

Sorry to be so frustrating and for annoying you. I have even tried changing the sheet names to - "Alpha", "Delta", "Bravo", "Echo","Papa", "Foxtrot", "November", "Whiskey", "Sierra". Would that confuse the code at all?:confused:
 
Upvote 0

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
The names in the array have to match exactly whatever the sheets tab name is (including any leading or trailing spaces).
 
Upvote 0
The sheet names are correct but the code errors on this line;

Code: 
For Each shtCnt In shtNames
'Highlighted in yellow

Code: 
  [TABLE]
<tbody>[TR]
[TD="class: xl65"]Sub   Test2()[/TD]
[/TR]
[TR]
[TD="class: xl65"]    Dim UsdRws As Long, NxtRw As Long[/TD]
[/TR]
[TR]
[TD="class: xl65"]    Dim shtNames, shtCnt[/TD]
[/TR]
[TR]
[TD="class: xl66"][/TD]
[/TR]
[TR]
[TD="class: xl65"]    shtNames = Array("Three",   "Four", "Five", "Six", "Seven",   "Eight", "Nine")[/TD]
[/TR]
[TR]
[TD="class: xl65"]    Application.ScreenUpdating = False[/TD]
[/TR]
[TR]
[TD="class: xl66"][/TD]
[/TR]
[TR]
[TD="class: xl65"]    For Each shtCnt In shtNames[/TD]
[/TR]
[TR]
[TD="class: xl65"]        On Error Resume Next[/TD]
[/TR]
[TR]
[TD="class: xl66"][/TD]
[/TR]
[TR]
[TD="class: xl65"]        With Worksheets(shtCnt)[/TD]
[/TR]
[TR]
[TD="class: xl65"]            UsdRws = .Range("S"   & Rows.Count).End(xlUp).Row[/TD]
[/TR]
[TR]
[TD="class: xl65"]            NxtRw =   Sheets("Totals").Range("B" &   Rows.Count).End(xlUp).Row[/TD]
[/TR]
[TR]
[TD="class: xl65"]              Sheets("Totals").Range("B" &   NxtRw).Resize(UsdRws - 12).Value = .Range("Z13:Z" &   UsdRws).Value[/TD]
[/TR]
[TR]
[TD="class: xl65"]              Sheets("Totals").Range("D" &   NxtRw).Resize(UsdRws - 12).Value = .Range("B13:D" &   UsdRws).Value[/TD]
[/TR]
[TR]
[TD="class: xl65"]              Sheets("Totals").Range("J" &   NxtRw).Resize(UsdRws - 12).Value = .Range("N13:N" &   UsdRws).Value[/TD]
[/TR]
[TR]
[TD="class: xl65"]              Sheets("Totals").Range("P" &   NxtRw).Resize(UsdRws - 12).Value = .Range("T13:T" &   UsdRws).Value[/TD]
[/TR]
[TR]
[TD="class: xl65"]        End With[/TD]
[/TR]
[TR]
[TD="class: xl66"][/TD]
[/TR]
[TR]
[TD="class: xl65"]        On Error GoTo 0[/TD]
[/TR]
[TR]
[TD="class: xl65"]    Next shtCnt[/TD]
[/TR]
[TR]
[TD="class: xl66"][/TD]
[/TR]
[TR]
[TD="class: xl65"]    Application.ScreenUpdating = True[/TD]
[/TR]
[TR]
[TD="class: xl66"][/TD]
[/TR]
[TR]
[TD="class: xl65"]End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Thank you for your patience.;)
 
Last edited:
Upvote 0
That code works for me, what is the error number & message you get?
 
Upvote 0
What does the error state? also how are you applying code tags, all you need to do is copy your code, paste it in the thread, select the code and click the # icon.


Edit: Apologies Fluff I was too slow in replying.
 
Last edited:
Upvote 0
It only says "Type Mismatch" and highlights the line
Code: 
For Each shtCnt In shtNames
No Error Message number.

That happens with the sheet names as - "Alpha", "Delta", "Bravo", "Echo","Papa", "Foxtrot", "November", "Whiskey", "Sierra".
 
Upvote 0
Please post the exact code you are using when you get the error.
 
Upvote 0
Here you go,

Code: 
Sub TimjanTest()
    Dim UsdRws As Long, NxtRw As Long
    Dim shtNames, shtCnt
MySheets = Array("Alpha", "Delta", "Bravo", "Echo", "Papa", "Foxtrot", "November", "Whiskey", "Sierra")
    Application.ScreenUpdating = False

        For Each shtCnt In shtNames

        On Error Resume Next

        With Worksheets(shtCnt)
            UsdRws = .Range("S" & Rows.Count).End(xlUp).Row 'The column to copy from each sheet to "Totals"
            NxtRw = Sheets("Totals").Range("B" & Rows.Count).End(xlUp).Row  'Copy to Row 14 and down In the "Totals" Sheet
            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

End Sub

You guys are amazing!
 
Upvote 0
The problem is that you are using two different names for the array, they need to be the same.
Code: 
    Dim [COLOR=#ff0000]shtNames[/COLOR], shtCnt
[COLOR=#0000ff]MySheets [/COLOR]= Array("Alpha", "Delta", "Bravo", "Echo", "Papa", "Foxtrot", "November", "Whiskey", "Sierra")
    Application.ScreenUpdating = False

        For Each shtCnt In [COLOR=#ff0000]shtNames[/COLOR]
 
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,263
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