Remapping Columns

[Nothnless]

Hi, I am importing data from a text file into excel.

Unfortunately the text file has stacked columns, so what would be the best way to convert the data from this:
[TABLE="width: 186"]
<colgroup><col span="2"></colgroup><tbody>[TR]
[TD]Name[/TD]
[TD]Address[/TD]
[/TR]
[TR]
[TD]Number[/TD]
[TD]Zip[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]1234 St.[/TD]
[/TR]
[TR]
[TD="align: right"]1111111[/TD]
[TD="align: right"]44444[/TD]
[/TR]
[TR]
[TD]Mary[/TD]
[TD]5678 St.[/TD]
[/TR]
[TR]
[TD="align: right"]2222222[/TD]
[TD="align: right"]55555[/TD]
[/TR]
[TR]
[TD]Jane[/TD]
[TD]8910 St.[/TD]
[/TR]
[TR]
[TD="align: right"]3333333[/TD]
[TD="align: right"]66666[/TD]
[/TR]
</tbody>[/TABLE]

To this:
[TABLE="width: 372"]
<colgroup><col span="4"></colgroup><tbody>[TR]
[TD]Name[/TD]
[TD]Number[/TD]
[TD]Address[/TD]
[TD]Zip[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD="align: right"]1111111[/TD]
[TD]1234 St.[/TD]
[TD="align: right"]44444[/TD]
[/TR]
[TR]
[TD]Mary[/TD]
[TD="align: right"]2222222[/TD]
[TD]5678 St.[/TD]
[TD="align: right"]55555[/TD]
[/TR]
[TR]
[TD]Jane[/TD]
[TD="align: right"]3333333[/TD]
[TD]8910 St.[/TD]
[TD="align: right"]66666[/TD]
[/TR]
</tbody>[/TABLE]

Wondering if I need to use some VBA or if this can be down with Power Query?

Thanks.

 

[mumps]

Try:

Sub NothnLess()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, x As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    desWS.Range("A1:B1").Value = srcWS.Range("A1:B1").Value
    desWS.Range("C1:D1").Value = srcWS.Range("A2:B2").Value
    For x = 3 To LastRow Step 2
        desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 2) = WorksheetFunction.Transpose(Cells(x, 1).Resize(2, 1))
    Next x
    For x = 3 To LastRow Step 2
        desWS.Cells(desWS.Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(1, 2) = WorksheetFunction.Transpose(Cells(x, 2).Resize(2, 1))
    Next x
    Application.ScreenUpdating = True
End Sub

The result will be on Sheet2.

 

[mumps]

One small modification:

Sub NothnLess()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, x As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    desWS.Range("A1:B1").Value = srcWS.Range("A1:B1").Value
    desWS.Range("C1:D1").Value = srcWS.Range("A2:B2").Value
    For x = 3 To LastRow Step 2
        desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 2) = WorksheetFunction.Transpose(srcWS.Cells(x, 1).Resize(2, 1))
    Next x
    For x = 3 To LastRow Step 2
        desWS.Cells(desWS.Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(1, 2) = WorksheetFunction.Transpose(srcWS.Cells(x, 2).Resize(2, 1))
    Next x
    Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

Try this. I assume the data starts in row 1

Sub Macro1()
    Dim u As Long
    Application.ScreenUpdating = False
    Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    u = Range("A" & Rows.Count).End(xlUp).Row
    Range("B1:B" & u & ",D1:D" & u).FormulaR1C1 = "=R[1]C[-1]"
    Columns("B:D").Copy
    Range("B1").PasteSpecial xlPasteValues
    For i = u To 1 Step -2
        Rows(i).Delete
    Next
End Sub