Copy & paste macro for multiple worksheets

[tomhelle]

I have a workbook with many worksheets. I recorded a macro (below) to copy
various cells from a “SetUp (Base)†worksheet and paste them on “Worksheet
1â€. I need help with two items:

1) I want the macro routine to work on any of the “worksheets†(I’ll use a
button on each worksheet that will enable the user to activate the macro for
that worksheet only).
2) The code that I recorded below goes back and forth to copy and paste the
data from the “SetUp (Base)†worksheet and “Worksheet 1â€. Is there a way
to make this more efficient? It works OK but there may be a better way to
structure the routine. Excel wouldn’t let me copy and paste multiple
selections
Any help would be greatly appreciated.

Thanks in advance - Tom


Sub SetUpBase()
'
' SetUpBase Macro
'
' Keyboard Shortcut: Ctrl+Shift+K
'
Sheets("Setup (Base)").Select
Range("Q5:S5").Select
Selection.Copy
Sheets("Worksheet 1").Select
Range("Q5:S5").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
Range("O1112").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("O1112").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("Setup (Base)").Select
Range("Q9:S12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("Q9:S12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("Setup (Base)").Select
ActiveWindow.SmallScroll Down:=9
Range("J14:S64").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("J14").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
Range("E19:E20").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("E19:E20").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
Range("E22:E28").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("E22:E28").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
Range("E55:E57").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
ActiveWindow.SmallScroll Down:=24
Range("E55:E57").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
Range("H55:H56").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("H55:H56").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
Range("C60:F64").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("C60").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
Range("H60:H64").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("H60").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
ActiveWindow.SmallScroll Down:=24
Range("S67:S83").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("S67").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
ActiveWindow.SmallScroll Down:=42
Range("E91:E92").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
ActiveWindow.SmallScroll Down:=30
Range("E91:E92").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
Range("H91:H92").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("H91:H92").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
Range("H103:I103").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("H103:I103").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
Range("B114:G116").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
ActiveWindow.SmallScroll Down:=15
Range("B114:E114").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
Range("B120:F125").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
ActiveWindow.SmallScroll Down:=12
Range("B120:E120").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Setup (Base)").Select
Range("L122:M123").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("L122:M123").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
Range("M124").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("M124").Select
ActiveSheet.Paste
Sheets("Setup (Base)").Select
Range("K125:M125").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("K125:M125").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-99
Range("B712").Select
End Sub

 

[dflak]

This is untested but you could set something up like

Option Base

sub SetUpBase (
Dim NumCopies as Long, iCopies as lon
Dim CopyRanges() as Strin

NumCopies = 1
ReDim CopyRanges(NumCopies

CopyRanges(1) = “Q5:S5â€
CopyRanges(2) = O1112
â€

For iCopies = 1 to NumCopie

Sheets("Setup (Base)").Select
Range(CopyRanges(iCopies)).Select
Selection.Copy
Sheets("Worksheet 1").Select
Range(CopyRanges(iCopies)).Select
ActiveSheet.Past

Nex
â€
End Su

There is a reason I deliberately set up the CopyRanges as an undimensioned array intitally. First I didn't count how many copies you actually did. So the 16 may be wrong. You will have to change it to match the number of copies you make

This makes the code a little more flexible in case you need to add, delete or change what you are copying

The code can be made "expandable" - that is, instead of describing the ranges in the code, you could list them in a named dynamic range on the spreadsheet, and define them there. So you won't have to change code, you will only have to change the spreadsheet. Then NumCopies becomes NumCopies = Range("YourRangeName").Rows.Count

To fill the array use
For iCopies = 1 to NumCopie
CopyRanges(iCopies) = Range("YourRangeName").Cells(iCopies,1
Nex

Good Luck.

 

[Per Jessen]

Hi

In this solution I use ActiveWorksheet as reference for destination
sheet, and I avoid to select ranges, as it is not needed, but slowing
down the macro.

I have only rewrote the first lines, and will leave it up to you to
change rest of the code based on my lines.

Sub SetUpBase()
'
' SetUpBase Macro
'
Dim TargetSh As Worksheet
Dim DestSh As Worksheet

Application.Screenupdating=False 'Turn off screenupdating

Set TargetSh = Sheets("Setup (Base)")
Set DestSh = ActiveWorksheet

TargetSh.Range("Q5:S5").Copy DestSh.Range("Q5:S5")
TargetSh.Range("O1112").Copy
DestSh.Range("O11").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
TargetSh.Range("Q9:S12").Copy
DestSh.Range("Q9:S12").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
TargetSh.Range("J14:S64").Copy DestSh.Range("J14")
TargetSh.Range("E19:E20").Copy DestSh.Range("E19:E20")

'---CUT---

application.CutCopyMode=False
Application.Screenupdating = True
End Sub

Hopes this helps.
....
Per

 

[tomhelle]

Hi dflak,

Many thanks for your help. I like the concept but I’m having some trouble. I
would really appreciate your help. It’s most likely lack of experience and
probably didn’t apply your instructions correctly.

Perhaps we could do a quick test. Let’s say we have a simple workbook with
the following worksheets: “Menuâ€, “Worksheet 1†and “Worksheet 2â€.

On "Menu", I have data in cells A1, B2 and C3. I named this range as
“CopyPasteâ€. The macro would grab the data from worksheet “Menu†and paste it
in “worksheet 1â€. I want this macro to work discretely on “worksheet 2â€, and
worksheets 3 and on.

When I run the code, I get a “compile error: Sub or function not definedâ€.

Here is the code I created:

Option Base 1

Sub CopyPaste()
Dim NumCopies As Long, iCopies As Long
Dim CopyRanges() As String

NumCopies = Range("CopyPaste").Rows.Count
ReDim CopyRanges(NumCopies)

CopyRanges(1) = “A1: A1â€Â
CopyRanges(2) = B2: B2 ""
…

For iCopies = 1 to NumCopies
CopyRanges(iCopies) = Range("CopyPaste").Cells(iCopies,1)
Sheets("Menu").Select
Range(CopyRanges(iCopies)).Select
Selection.Copy
Sheets("Worksheet 1").Select
Range(CopyRanges(iCopies)).Select
ActiveSheet.Paste

Next
…
End Sub

 

[tomhelle]

Thanks Per. I gave it a try and get a run-time error at line:

Set DestSh = ActiveWorksheet

Is there some code I need to insert on each of my destination sheets? As you
call tell, I'm not very experienced with vba but hope you can help.

Tom

 

[Per Jessen]

Sorry, my fault it shuld have been:

Set DestSh = ActiveSheet

Regards,
Per

 

[tomhelle]

Per - Beautiful! This is exactly what I was looking for. Thank you so much!

Tom

 

[tomhelle]

Thanks for your help on this. I have a solution that Per provided that works
very well but thanks for your help!

Tom

 

[Per Jessen]

Tom,

Thanks for your reply. I am always glad to help.

Per