VBA to create a Loop for routine copy and paste to another Workbook

TheHack22

Board Regular
Joined
Feb 3, 2021
Messages
121
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
Hi All,

I have some copy and paste routines to specific worksheets. Here is my current code that is working well, but it's not the most efficient VBA. Can someone help me with a loop?



VBA Code:
Sub CLASS_1_US()
    Sheets("CLASS 1 - US").Select
    Range("L2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
      
End Sub
Sub CLASS_2_US()
Sheets("CLASS 2 - US").Select
    Range("L2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
  
End Sub
Sub CLASS_3_US()
Sheets("CLASS 3 - US").Select
    Range("J2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
  
End Sub
Sub CLASS_4_US()
Sheets("CLASS 4 - US").Select
    Range("L2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
  
End Sub
Sub CLASS_6_US()
Sheets("CLASS 6 - US").Select
    Range("L2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
  
End Sub
Sub CLASS_9_US()
Sheets("CLASS 9 - US").Select
    Range("L2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
  
End Sub
Sub CLASS_1_INTL()
    Sheets("CLASS 1 - INTL").Select
     Range("L2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
  
  
End Sub
Sub CLASS_2_INTL()
    Sheets("CLASS 2 - INTL").Select
     Range("L2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
  
End Sub
Sub CLASS_3_INTL()
    Sheets("CLASS 3 - INTL").Select
     Range("J2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
  
End Sub
Sub CLASS_4_INTL()
    Sheets("CLASS 4 - INTL").Select
     Range("L2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
  
End Sub
Sub CLASS_6_INTL()
    Sheets("CLASS 6 - INTL").Select
     Range("L2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
  
End Sub
Sub MasterFillDownTemplate()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

    Call CLASS_1_US
    Call CLASS_2_US
    Call CLASS_3_US
    Call CLASS_4_US
    Call CLASS_6_US
    Call CLASS_9_US
    Call CLASS_1_INTL
    Call CLASS_2_INTL
    Call CLASS_3_INTL
    Call CLASS_4_INTL
    Call CLASS_6_INTL
  
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "All Formulas copied and pasted"
End Sub

Imran
 
Last edited by a moderator:

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Here is a shortened version, see if this works properly for you:

VBA Code:
Sub MasterFillDownTemplate()
'
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
'
    Sheets("CLASS 1 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 2 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 3 - US").Select
    Range("J2").Select
    Call CommonCode
'
    Sheets("CLASS 4 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 6 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 9 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 1 - INTL").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 2 - INTL").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 3 - INTL").Select
    Range("J2").Select
    Call CommonCode
'
    Sheets("CLASS 4 - INTL").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 6 - INTL").Select
    Range("L2").Select
    Call CommonCode
'
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
'
    MsgBox "All Formulas copied and pasted"
End Sub


Sub CommonCode()
'
    Range(Selection, Selection.End(xlToRight)).Copy
'
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
'
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub
 
Upvote 0
Solution
Here is a shortened version, see if this works properly for you:

VBA Code:
Sub MasterFillDownTemplate()
'
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
'
    Sheets("CLASS 1 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 2 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 3 - US").Select
    Range("J2").Select
    Call CommonCode
'
    Sheets("CLASS 4 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 6 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 9 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 1 - INTL").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 2 - INTL").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 3 - INTL").Select
    Range("J2").Select
    Call CommonCode
'
    Sheets("CLASS 4 - INTL").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 6 - INTL").Select
    Range("L2").Select
    Call CommonCode
'
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
'
    MsgBox "All Formulas copied and pasted"
End Sub


Sub CommonCode()
'
    Range(Selection, Selection.End(xlToRight)).Copy
'
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
'
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub
@jonnyL

Thanks very much. I'll test this tomorrow at work and provide some feedback. This is so organized and clear for a layman like me to understand.

Imran
 
Upvote 0
Here is a shortened version, see if this works properly for you:

VBA Code:
Sub MasterFillDownTemplate()
'
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
'
    Sheets("CLASS 1 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 2 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 3 - US").Select
    Range("J2").Select
    Call CommonCode
'
    Sheets("CLASS 4 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 6 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 9 - US").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 1 - INTL").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 2 - INTL").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 3 - INTL").Select
    Range("J2").Select
    Call CommonCode
'
    Sheets("CLASS 4 - INTL").Select
    Range("L2").Select
    Call CommonCode
'
    Sheets("CLASS 6 - INTL").Select
    Range("L2").Select
    Call CommonCode
'
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
'
    MsgBox "All Formulas copied and pasted"
End Sub


Sub CommonCode()
'
    Range(Selection, Selection.End(xlToRight)).Copy
'
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
'
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub
@johnnyL

Thanks so much. This works perfectly.
Imran
 
Upvote 0

Forum statistics

Threads
1,213,563
Messages
6,114,329
Members
448,564
Latest member
ED38

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