Simplify Recorded Macro

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>
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
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!:eeek:

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
Are you the same Fluff who is also on Excel Forum?
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
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!:eeek:

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!:crash:

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.:banghead:

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

Forum statistics

Threads
1,223,162
Messages
6,170,431
Members
452,326
Latest member
johnshaji

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