Thanks to Charles' generous offer this is probably not needed, but since
I already wrote it, here goes.
Since inserting multiple rows can be a bit of a headache, I decided to
simply copy the relevant data onto another spreadsheet. Maybe this will
suffice, maybe not.
I assumed that the original data was on "sheet1", starting on row 2
(leaving row 1 for titles).
Sub Do_It()
Dim i As Long, j As Long
Dim k As Long ' counter tracking number of new entries
Dim priname As String, surname As String
dim cost_centre As String, LineManager As String
'assume that original entries are on sheet1, and they
'are being copied to sheet2
i = 2
k = 0
Do
If Sheets("sheet1").Cells(i, 1) = "" Then
'reached the end of the list
Exit Do
End If
priname = Sheets("sheet1").Cells(i, 1)
surname = Sheets("sheet1").Cells(i, 2)
cost_centre = Sheets("sheet1").Cells(i, 4)
LineManager = Sheets("sheet1").Cells(i, 11)
For j = 12 To 26
If Sheets("sheet1").Cells(i, j) < "" Then
k = k + 1 'increment new row counter
Sheets("sheet2").Cells(k, 1) = priname
Sheets("sheet2").Cells(k, 2) = surname
Sheets("sheet2").Cells(k, 4) = cost_centre
Sheets("sheet2").Cells(k, 11) = LineManager
Sheets("sheet2").Cells(k, 27) =
Sheets("sheet1").Cells(1, j)
Sheets("sheet2").Cells(k, 28) =
Sheets("sheet1").Cells(i, j)
End If
Next j
i = i + 1
Loop
End Sub
*** Sent via Developersdex
http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!