View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.misc
Per Jessen Per Jessen is offline
external usenet poster
 
Posts: 1,533
Default Copy & paste macro for multiple worksheets

Sorry, my fault it shuld have been:

Set DestSh = ActiveSheet

Regards,
Per

"tomhelle" skrev i meddelelsen
...
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" wrote:

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("O11:P12").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

On 12 Mar., 22:42, tomhelle
wrote:
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€ť (Ill
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 wouldnt 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("O11:P12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Worksheet 1").Select
Range("O11:P12").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("B7:D12").Select
End Sub


.