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

[spgexcel]

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.

_______________________________________________________________________________________________________________________________________________________

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

 

[Fluff]

How about

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]

How about

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

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]

Not a major difference, but I would do it like

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

 

[spgexcel]

Not a major difference, but I would do it like

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]

You're welcome & thanks for the feedback.