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>
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
You can simplify that code like
Code: 
Sub Timjan()
   With Sheets("Oos")
      Sheets("Totals").Range("B14:B16").Value = .Range("Z13:Z15").Value
      Sheets("Totals").Range("D14:F16").Value = .Range("B13:D15").Value
      Sheets("Totals").Range("J14:J16").Value = .Range("N13:N15").Value
      Sheets("Totals").Range("P14:P16").Value = .Range("T13:T15").Value
   End With
End Sub
Where would the other sheets get copied too?
 
Upvote 0
Wow! You are quick.

Thank you for your suggestion. I know of that method but, my problem is that the Code should copy from Sheet("Oos") from each Column Row Range based on the last Cell populated in Column S, so there is no fixed depth of data in Column S of said Sheets. The Code should Start from say Sheet 1 through Sheet 8 and append the various lengths of data to the "Totals" Sheet.

That is where I am stuck!:eek:

Thank you for you.
 
Upvote 0
So sheet 1 copies to B14 downwards & the sheet2 copies below that etc, is that right?
Also what are the names of the sheets?
 
Upvote 0
Are you the same Fluff who is also on Excel Forum?

If so, then I have struck GOLD, having seen your brilliant solutions to so many Posts!

Your first assumption is spot on.
The names of the remaining Sheets are Sheet3 to Sheet9

Where is Chippenham?

I appreciate your help, thank you.
 
Upvote 0
Timjan said:
Are you the same Fluff who is also on Excel Forum?
Click to expand...
Nope, that Fluff is the same as the one that posts here ;)

Will there always be data in B13 on the Totals sheet?
 
Last edited:
Upvote 0
Nope, that Fluff is the same as the one that posts here
Click to expand...
LOL! It is so good to meet a person with a great sense of humor.

There will always be data in B13 on the Totals sheet as it contains a formula which may return a blank in an extreme case.
 
Upvote 0
Ok, try this
Code: 
Sub Timjan()
   Dim UsdRws As Long, NxtRw As Long, i As Long
   
   For i = 1 To 8
      With Sheets("Sheet" & 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
Thank you, Fluff.

It looks as if it could work just fine!:biggrin:
I knew that Rows.Count and End(xlUp) should feature somewhere, but I had never thought of using Resize!:eek:

Logging out now to put your masterpiece at work. I report back a.s.a.p.

Thanks for your your time and help.:wink:
 
Upvote 0
Hi Fluff,

Please don't get mad at me. My aged brain is failing me and it is so embarrassing!:oops:

In Post #5 I stated that the names of the remaining Sheets are Sheet3 to Sheet9, which is wrong since I was stuck on the sheet index numbers.
The names of the remaining Sheets are actually Region3 to Region9.:oops:

Please forgive me, and find it somewhere in your good heart to amend your code to cater for same. Old age is a bugger and, certainly not for sissies!

Thank you in advance.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Counter in For Each loop
Replies
2
Views
203
Possum17
P
A
  • Question
Macro to update list to last row on another sheet copy source from multiple sheets
Replies
0
Views
315
Azamamir
A
P
  • Solved
Need help with macro Dynamic Range??
Replies
6
Views
180
pennbowl
P
J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
177
shknbk2
S
P
  • Solved
Recorded Macro Ammendments
Replies
3
Views
349
Joe4
Joe4

Forum statistics

Threads
1,215,143
Messages
6,123,274
Members
449,093
Latest member
Vincent Khandagale

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