Woza
I've made a few assumptions:
- You have Excel 97 to 2003 (It will work in 2007, but not if there are over 65536 rows)
- Your top left of your data is in A1
If so, then this code should work.
Sub MoveData()
Dim lStartLastrow As Long, lEndLastRow As Long
Dim myCell As Range
Dim strJobNo As String
lStartLastrow = Range("A65536").End(xlUp).Row
Columns("A:A").Insert
Range("A1").Value = "JobNo."
Range("B1").Value = "Expense"
Range("E1").Value = "Index"
strJobNo = "Job1"
With Range("E2")
.Value = 1
.AutoFill Range("E2:E" & lStartLastrow), xlFillSeries
End With
For Each myCell In Range("A2:A" & lStartLastrow)
If Left(myCell.Offset(0, 1).Value, 3) = "Job" Then
strJobNo = myCell.Offset(0, 1).Value
myCell.Offset(0, 1).Clear
ElseIf myCell.Offset(0, 1).Value = "" Then myCell.Value = ""
Else: myCell.Value = strJobNo
End If
Next myCell
Range("A1:E" & lStartLastrow).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("E2") _
, Order2:=xlAscending, Header:=xlYes
lEndLastRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
Range("A" & lEndLastRow & ":A" & lStartLastrow).EntireRow.Delete
Range("A1:E" & lStartLastrow).Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlYes
Columns("E:E").Delete
Columns("A:D").AutoFit
End Sub
Regards
Nick Hodge
Microsoft MVP, Excel
Southampton, UK