|
Copy & paste macro for multiple worksheets
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 |
Copy & paste macro for multiple worksheets
This is untested but you could set something up like:
Option Base 1 sub SetUpBase () Dim NumCopies as Long, iCopies as long Dim CopyRanges() as String NumCopies = 16 ReDim CopyRanges(NumCopies) CopyRanges(1) = €śQ5:S5€ť CopyRanges(2) = O11:P12" €¦ For iCopies = 1 to NumCopies Sheets("Setup (Base)").Select Range(CopyRanges(iCopies)).Select Selection.Copy Sheets("Worksheet 1").Select Range(CopyRanges(iCopies)).Select ActiveSheet.Paste Next €¦ End Sub 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 NumCopies CopyRanges(iCopies) = Range("YourRangeName").Cells(iCopies,1) Next Good Luck. --- frmsrcurl: http://msgroups.net/microsoft.public...ple-worksheets |
Copy & paste macro for multiple worksheets
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” (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("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 |
Copy & paste macro for multiple worksheets
Hi dflak,
Many thanks for your help. I like the concept but Im having some trouble. I would really appreciate your help. Its most likely lack of experience and probably didnt apply your instructions correctly. Perhaps we could do a quick test. Lets 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 "dflak" wrote: This is untested but you could set something up like: Option Base 1 sub SetUpBase () Dim NumCopies as Long, iCopies as long Dim CopyRanges() as String NumCopies = 16 ReDim CopyRanges(NumCopies) CopyRanges(1) = €œQ5:S5€ CopyRanges(2) = O11:P12" €¦ For iCopies = 1 to NumCopies Sheets("Setup (Base)").Select Range(CopyRanges(iCopies)).Select Selection.Copy Sheets("Worksheet 1").Select Range(CopyRanges(iCopies)).Select ActiveSheet.Paste Next €¦ End Sub 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 NumCopies CopyRanges(iCopies) = Range("YourRangeName").Cells(iCopies,1) Next Good Luck. --- frmsrcurl: http://msgroups.net/microsoft.public...ple-worksheets . |
Copy & paste macro for multiple worksheets
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 . |
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 . |
Copy & paste macro for multiple worksheets
Per - Beautiful! This is exactly what I was looking for. Thank you so much!
Tom "Per Jessen" wrote: 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 . . |
Copy & paste macro for multiple worksheets
Thanks for your help on this. I have a solution that Per provided that works
very well but thanks for your help! Tom "dflak" wrote: This is untested but you could set something up like: Option Base 1 sub SetUpBase () Dim NumCopies as Long, iCopies as long Dim CopyRanges() as String NumCopies = 16 ReDim CopyRanges(NumCopies) CopyRanges(1) = €œQ5:S5€ CopyRanges(2) = O11:P12" €¦ For iCopies = 1 to NumCopies Sheets("Setup (Base)").Select Range(CopyRanges(iCopies)).Select Selection.Copy Sheets("Worksheet 1").Select Range(CopyRanges(iCopies)).Select ActiveSheet.Paste Next €¦ End Sub 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 NumCopies CopyRanges(iCopies) = Range("YourRangeName").Cells(iCopies,1) Next Good Luck. --- frmsrcurl: http://msgroups.net/microsoft.public...ple-worksheets . |
Copy & paste macro for multiple worksheets
Tom,
Thanks for your reply. I am always glad to help. Per On 14 Mar., 23:06, tomhelle wrote: Per - Beautiful! This is exactly what I was looking for. Thank you so much! Tom |
| All times are GMT +1. The time now is 02:23 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com