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:

Name	Address
Number	Zip
John	1234 St.
1111111	44444
Mary	5678 St.
2222222	55555
Jane	8910 St.
3333333	66666

<colgroup><col span="2"></colgroup><tbody>
</tbody>

To this:

Name	Number	Address	Zip
John	1111111	1234 St.	44444
Mary	2222222	5678 St.	55555
Jane	3333333	8910 St.	66666

<colgroup><col span="4"></colgroup><tbody>
</tbody>

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