Excel Macro - Loop to copy column of cells into row 1

[jupops]

Good Morning

Could anybody please help. I am trying to write a macro that will concatenate cells or move the row up to the next column of a cell which starts with a number, Then stops when the row is empty. But then moves down the row until the cell starts with a number and repeats the procedure until it the end of the report. I have been trying to write the loop and moving the row (or in the case cell) into the cell that is empty of the cell that starts with a number,

For Example,, All the below are in column A and starts from Row 1

7300002 ALIT 1109 041109
BRANDED LEIS iINFO
THIS ITEM IS SUBJECT
INSPECTION BY JOE

7300003 ALIM 311211
ABCD CHECK
ALL OK

7300003 FRED 2511011211
OPEN WHEN READYY
ABCD NOT CHECKED
SUBJECT TO FFRES
DEK GO TO BAR
INSPECTION BY JAMES



So I tried to copy A1 (7300002 ALIT 1109 041109) into A1 on a new sheet, then because next cell below was not empty (A2 - BRANDED LEIS iINFO) copied into B1 on the new sheet, Then it would move down to the next cell (A3 - THIS ITEM IS SUBJECT) and this would go into C1 on new sheet and repeat so A4 (INSPECTION BY JOE) will be copied to D1 on new sheet. Now because the row is blank it ends the loop and Finds the next populated cell from the first sheet and repeats the operation, but copying to row 2 on new sheet so A6 (7300003 ALIM 311211) copied to A2, A7 (ABCD CHECK) Coped to B2 and A8 (ALL OK) copied to C2. Again with the blank row ends loop.

This is repeated until end of document,

I would be grateful for any guidance. Thank You

Regards

Jupops

 

[SkipVought]

This ought to do it...

Sub testit()
    Dim r As Range, lRow As Long, iCol As Integer, wsIN As Worksheet, wsOUT As Worksheet
    
    Set wsIN = ActiveSheet
    Set wsOUT = Worksheets.Add(after:=Sheets(Sheets.Count))
    
    lRow = 2
    iCol = 1
    With wsIN
        For Each r In Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
            If Trim(r.Value) = "" Then
                lRow = wsOUT.[A1].CurrentRegion.Rows.Count + 1
                iCol = 1
            Else
                wsOUT.Cells(lRow, iCol).Value = r.Value
                iCol = iCol + 1
            End If
        Next
    End With
    
    Set wsIN = Nothing
    Set wsOUT = Nothing
End Sub

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[jupops]

Good evening Skip

What can I say but it is perfect,

Thank YOu

Regatds

Jupops