Excel VBA：将一行拆分为多行

Question

I have a row of cells that contains data that needs to be turned into multiple rows.

18-Apr-17 11:00:30 SkyFlyer1_Leg1 319437.222 146279.951 -32.768 SkyFlyer1_Leg2 319417.07 146268.105 -32.768 SkyFlyer1_Leg3 319410.548 146268.368 -32.768

This is half of one line (there are 8 legs). The spaces indicate deliminations between the cells.

Each "SkyFlyer_Leg*" needs a carrage return to take it onto a new line.

These lines are being brought into the worksheet using another script that is parsing them from a CSV.

Option Explicit

Sub CSVParser_99()

Dim i As Long
Dim x As Long
Dim LastRow As Long
Dim PasteRow As Long

   With Sheets("CSV Paste")
        LastRow = .Range("A3").End(xlDown).Row
        For i = 3 To LastRow
            PasteRow = Sheets("Working Sheet 1").Cells(Sheets("Working Sheet 1").Rows.Count, "A").End(xlUp).Row
        .Range(.Range("A" & i), .Range("A" & i).End(xlToRight)).Copy Destination:=Sheets("Working Sheet 1").Range("A" & PasteRow + 1)

        Call RowDiv

    Next i
End With

End Sub

---

Sub RowDiv()

Dim Row1 As Variant

With Sheets("Working Sheet 1")
    .Range("C6000").End(xlUp).Select
End With

With Row1.ActiveCell

End With

End Sub

This is what I have got so far, including the script that brings the code into this page. (Thanks to Shai Rado for the help so far)

The result I want would have the data arranged like:

18-Apr-17| 11:00:30

SkyFlyer1_Leg1| 319437.222| 146279.951| -32.768

SkyFlyer1_Leg2| 319417.070| 146268.105| -32.768

SkyFlyer1_Leg3| 319410.548| 146268.368| -32.768

Any help would be greatly appreciated.

Cheers, J

Answer 1

Maybe this would work

Sub CSVParser_99()

    Dim i As Long
    Dim x As Long
    Dim LastRow As Long
    Dim PasteRow As Long

       With Sheets("CSV Paste")
            LastRow = .Range("A3").End(xlDown).Row
            For i = 3 To LastRow
                PasteRow = Sheets("Working Sheet 1").Cells(Sheets("Working Sheet 1").Rows.Count, "A").End(xlUp).Row
            .Range(.Range("A" & i), .Range("A" & i).End(xlToRight)).Copy Destination:=Sheets("Working Sheet 1").Range("A" & PasteRow + 1)

            Call RowDiv

        Next i
    End With

End Sub

Sub RowDiv()

    Dim Row1 As Range

    With Sheets("Working Sheet 1")
        Set Row1 = .Range("A6000").End(xlUp)
    End With

    With Row1

        .TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
            ), Array(14, 1)), TrailingMinusNumbers:=True
    End With

End Sub