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

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
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

C
  • Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
98
myall_blues
myall_blues
C
  • Solved
Please help me clean up my VBA script, I'm having trouble with redundancies
Replies
4
Views
124
CapRavOr
C
P
  • Solved
Counter in For Each loop
Replies
2
Views
243
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
230
pennbowl
P

Forum statistics

Threads
1,215,848
Messages
6,127,275
Members
449,372
Latest member
charlottedv

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