Hello all. Was hoping that someone could help me with with a macro that I'm wanting loop. Basically, I have a spreadsheet that has somewhere in the area of 300-400 or more records each day. All of the data is on 1 line, except for a client name and address which drops down a few lines. What I want to do is have a macro that will put this information into more of a database format and delete the extra and blank rows. I want the macro to loop and run until it encounters nothing but blank rows. The macro currently looks something like this if I do it manually. Any help with this would be appreciated. I can give an example spreadsheet that shows how the data is laid out and how I want it to appear if needed.

Sub Reformatting()
'
' Reformatting Macro
' Macro recorded 06/07/2007 by NSmith
'

'
Range("B3:B4").Select
Selection.Copy
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Rows("3:7").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("B4:B5").Select
Selection.Copy
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Rows("4:8").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("B5:B6").Select
Selection.Copy
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Rows("5:9").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("B6:B7").Select
Selection.Copy
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Rows("6:10").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("B7:B8").Select
Selection.Copy
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Rows("7:9").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("A1").Select
End Sub