Hi ksuwyldkat,
I'm not entirely sure what you want here but if your report is exactly like the one you posted this should get you started ..
Sub ReportExtract()
Dim lReportRow As Long
Dim lSheetRow As Long
Dim lAccount As Long
lSheetRow = 2
lReportRow = 3
Do Until Sheets("New Report").Cells(lReportRow, 1) = ""
If Split(Sheets("New Report").Cells(lReportRow, 1))(0) = "Account:" Then
' New Account - Save Number and skip next row (headings)
lAccount = CLng(Split(Sheets("New Report").Cells(lReportRow, 1))(1))
lReportRow = lReportRow + 2
Else
' Detail row
Sheets("Sheet3").Cells(lSheetRow, 1) = lAccount
Sheets("Sheet3").Cells(lSheetRow, 2) = Sheets("New Report").Cells(lReportRow, 1)
Sheets("Sheet3").Cells(lSheetRow, 3) = Sheets("New Report").Cells(lReportRow, 2)
Sheets("Sheet3").Cells(lSheetRow, 4) = Sheets("New Report").Cells(lReportRow, 4)
Sheets("Sheet3").Cells(lSheetRow, 5) = Sheets("New Report").Cells(lReportRow, 5)
Sheets("Sheet3").Cells(lSheetRow, 6) = Sheets("New Report").Cells(lReportRow, 6)
Sheets("Sheet3").Cells(lSheetRow, 7) = Sheets("New Report").Cells(lReportRow, 7)
Sheets("Sheet3").Cells(lSheetRow, 8) = Sheets("New Report").Cells(lReportRow, 8)
lSheetRow = lSheetRow + 1
lReportRow = lReportRow + 1
End If
Loop
End Sub