Macro to copy last row of data into multiple rows below

[Andrew B]

[FONT=&quot]Hi All!
I have a macro that copies the last row of data on Sheet1 into the row below it:

[/FONT]

  [FONT=&quot]Sub CopyRow()[/FONT]
  
  [FONT=&quot]Dim LR As Long[/FONT]
  
  [FONT=&quot]With Sheets("Sheet1")[/FONT]
  [FONT=&quot]    LR = .Range("A" & Rows.Count).End(xlUp).Row[/FONT]
  
  [FONT=&quot]    .Rows(LR).Copy Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)[/FONT]
  
  [FONT=&quot] End With[/FONT]
  [FONT=&quot]End Sub[/FONT]

[FONT=&quot]

I need it to copy that data into the 10 rows below it. I know that copying the expression

.Rows(LR).Copy Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)

ten times will work (I've tried it), but surely there is a more elegant way of scripting the command. Can anyone help me? I'm clueless
Thanks,
Andrew B[/FONT]

 

[AlphaFrog]

Try re-sizing the destination to 10 rows.

.Rows(LR).Copy Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)[COLOR="Red"].Resize(10)[/COLOR]

 

[Andrew B]

AlphaFrog,

Thank you very much for your speedy and helpful reply. It works great!!!

Sincerely,
Andrew