Thanks Dave. I've tweaked it for some detail I didn't include in the
original and so far it seems to be working. The spreadsheet it needs to run
across in its raw form is 2000 lines long so I now have some testing to do!

"Dave Peterson" wrote:

Try this against a copy of your worksheet:

Option Explicit
Sub testme01()

'1) Inserts 3 new rows
'2) Copies cells A6 - O6 and pastes them in the three new rows
'3) Copies the data in R6 and S6 and pastes it in P7 and Q7
'4) Copies the data in T6 and U6 and pastes it in P8 and Q8
'5) Copies the data in V6 and W6 and pastes it in P9 and Q9

Dim FirstRow As Long
Dim LastRow As Long
Dim wks As Worksheet
Dim iRow As Long

Set wks = Worksheets("Sheet1")

With wks
FirstRow = 6
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(3).Insert

.Cells(iRow, "A").Resize(1, 15).Copy
.Cells(iRow + 1, "A").Resize(3, 1).PasteSpecial _
Paste:=xlPasteValues

.Cells(iRow, "R").Resize(1, 2).Copy
.Cells(iRow + 1, "P").Resize(1, 2).PasteSpecial _
Paste:=xlPasteValues

.Cells(iRow, "t").Resize(1, 2).Copy
.Cells(iRow + 2, "P").Resize(1, 2).PasteSpecial _
Paste:=xlPasteValues

.Cells(iRow, "v").Resize(1, 2).Copy
.Cells(iRow + 3, "P").Resize(1, 2).PasteSpecial _
Paste:=xlPasteValues

Next iRow
End With
Application.CutCopyMode = false
End Sub


KatJ wrote:

Hi,

I've written a macro that starts in row 6 in my spreadsheet. It:

1) Inserts 3 new rows
2) Copies cells A6 - O6 and pastes them in the three new rows
3) Copies the data in R6 and S6 and pastes it in P7 and Q7
4) Copies the data in T6 and U6 and pastes it in P8 and Q8
5) Copies the data in V6 and W6 and pastes it in P9 and Q9

I'd now like to make this macro loop through my whole spreadsheet until it
gets to a blank row, but I haven't been able to. I've tried a do loop but
keep getting errors. I think my main problem is trying to replace my
absolute references with variables. Can anyone help me?

This is the macro as it stands

Rows("7:9").Select
Selection.Insert Shift:=xlDown
Range("A6:O6").Select
Selection.Copy
Range("A7:A9").Select
ActiveSheet.Paste
Range("R6:S6").Select
Selection.Copy
Range("P7").Select
ActiveSheet.Paste
Range("T6:U6").Select
Selection.Copy
Range("P8").Select
ActiveSheet.Paste
Range("V6:W6").Select
Selection.Copy
Range("P9").Select
ActiveSheet.Paste

Thanks for your help!

Kat

--

Dave Peterson