title: VBA copy rows fast
body: <p>I have to work on files with 5000 rows, for each row I have to insert 3 more rows and copy the content in these new rows (after that there will be more steps).
  My macro works fine but the process of copying the content is really slow, I´m sure there is a solution that works better, any ideas? </p>
  
  <pre><code>Sub copy_rows()
  
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  Application.DisplayStatusBar = False
  
  Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
  Lastrow = Lastrow * 4
  
  For i = 1 To Lastrow Step 4
  Cells(i, 7).EntireRow.Offset(1).Resize(3).Insert Shift:=xlDown
  Rows(i).Copy Destination:=Rows(i + 1)
  Rows(i).Copy Destination:=Rows(i + 2)
  Rows(i).Copy Destination:=Rows(i + 3)
  Next i
  
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
  Application.DisplayStatusBar = True
  
  End Sub
  </code></pre>
  
  <p>Thank you very much</p>