Copy from one sheet and Paste in another sheet using VBA with loop

spgexcel

New Member
Joined
Mar 16, 2016
Messages
16
Office Version
  1. 365
Platform
  1. Windows
Hi,

I have been learning to write VBA for past few months.
By whatever I learnt, I typed following code. I need your help to optimize this code so that it is more faster and efficient.
One thing I tried doing was to avoid .Select method because I know it is not good idea to use it unless needed but did not succeed.

In brief about the code below:
1. First part is to copy paste total 4 (which is value of B2) tables one by one and paste the table in range starting at "F7" as values
2. The table where I paste the values is linked to another sheet which calculates results in the table called "Final_Shares" in sheet named "Event"
3. Then I copy from this "Final_Share" table to another sheet called "US calculation" starting from "E18" cell then next table will be pasted in cells after 241 rows from E18 and so on.

_______________________________________________________________________________________________________________________________________________________
VBA Code:
Sub copypaste()

Application.ScreenUpdating = False
Dim i As Long
   

For i = 1 To Worksheets("ME").Range("B2").Value

 Sheets("ME").Select
    Range("US_Table").Offset((21 * i) - 21, 0).Select
    Selection.Copy
    Range("F7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
Application.Calculation = xlCalculationManual
       
    Sheets("Event").Select
    Range("Final_Shares").Select
    Selection.Copy
   
Sheets("US Calculation").Select
    Range("E18").Offset((241 * i) - 241, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
  Application.Calculation = xlCalculationAutomatic

Next i

   Application.ScreenUpdating = True


End Sub
 
Last edited by a moderator:

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
77,703
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub copypaste()

   Application.ScreenUpdating = False
   Dim i As Long
   
   With Sheets("Event")
      For i = 1 To Worksheets("ME").Range("B2").Value
      
         .Range("US_Table").Offset((21 * i) - 21, 0).Copy
         .Range("F7").PasteSpecial xlPasteValues
         Application.Calculation = xlCalculationManual
         
         .Range("Final_Shares").Copy
         Sheets("US Calculation").Range("E18").Offset((241 * i) - 241, 0).PasteSpecial xlPasteValues
         
         Application.Calculation = xlCalculationAutomatic
         
      Next i
   End With
   Application.ScreenUpdating = True
End Sub
 

spgexcel

New Member
Joined
Mar 16, 2016
Messages
16
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub copypaste()

   Application.ScreenUpdating = False
   Dim i As Long
  
   With Sheets("Event")
      For i = 1 To Worksheets("ME").Range("B2").Value
     
         .Range("US_Table").Offset((21 * i) - 21, 0).Copy
         .Range("F7").PasteSpecial xlPasteValues
         Application.Calculation = xlCalculationManual
        
         .Range("Final_Shares").Copy
         Sheets("US Calculation").Range("E18").Offset((241 * i) - 241, 0).PasteSpecial xlPasteValues
        
         Application.Calculation = xlCalculationAutomatic
        
      Next i
   End With
   Application.ScreenUpdating = True
End Sub

Hi Fluff,

Thank you very much for quick response. However the code gave me an error after which I figured there need to be 2 With Sheet statements since 2 separate sheets are involved in first half of the code. I modified it as below. It works but do you think it is a right thing to do with such 2 With Sheet statements

VBA Code:
Sub copypaste()

   Application.ScreenUpdating = False
   Dim i As Long


 With Sheets("ME")
        
    For i = 1 To Worksheets("ME").Range("A2").Value
    
    .Range("US_Table").Offset((21 * i) - 21, 0).Copy
    .Range("F7").PasteSpecial xlPasteValues
     Application.Calculation = xlCalculationManual
     
   With Sheets("Event")
   
    .Range("Final_Shares").Copy
    Sheets("Stage IIIa-b-c C-CRT").Range("E18").Offset((241 * i) - 241, 0).PasteSpecial xlPasteValues
    End With
Application.Calculation = xlCalculationAutomatic

   Application.ScreenUpdating = True
   
Next i

End With

End Sub

Thanks
Sumant
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
77,703
Office Version
  1. 365
Platform
  1. Windows
Not a major difference, but I would do it like
VBA Code:
Sub copypaste()

   Application.ScreenUpdating = False
   Dim i As Long


 With Sheets("ME")
        
    For i = 1 To .Range("A2").Value
    
    .Range("US_Table").Offset((21 * i) - 21, 0).Copy
    .Range("F7").PasteSpecial xlPasteValues
     Application.Calculation = xlCalculationManual
End With
   With Sheets("Event")
   
    .Range("Final_Shares").Copy
    Sheets("Stage IIIa-b-c C-CRT").Range("E18").Offset((241 * i) - 241, 0).PasteSpecial xlPasteValues
    End With
Application.Calculation = xlCalculationAutomatic

   Application.ScreenUpdating = True
   
Next i


End Sub
 
Solution

spgexcel

New Member
Joined
Mar 16, 2016
Messages
16
Office Version
  1. 365
Platform
  1. Windows
Not a major difference, but I would do it like
VBA Code:
Sub copypaste()

   Application.ScreenUpdating = False
   Dim i As Long


 With Sheets("ME")
       
    For i = 1 To .Range("A2").Value
   
    .Range("US_Table").Offset((21 * i) - 21, 0).Copy
    .Range("F7").PasteSpecial xlPasteValues
     Application.Calculation = xlCalculationManual
End With
   With Sheets("Event")
  
    .Range("Final_Shares").Copy
    Sheets("Stage IIIa-b-c C-CRT").Range("E18").Offset((241 * i) - 241, 0).PasteSpecial xlPasteValues
    End With
Application.Calculation = xlCalculationAutomatic

   Application.ScreenUpdating = True
  
Next i


End Sub
Perfect. This is what I was looking for.
Thanks alot.

Sumant
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
77,703
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Forum statistics

Threads
1,176,085
Messages
5,901,295
Members
434,886
Latest member
qazibelal

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
Top