Move 5 columns from one sheet to another but place into one row

I have 5 columns in a data source that I need to pull:

Line1|Line2|Line3|Line4|Line5

...all with data under them. I need to pull those 5 columns into a new sheet and not only rename them, but create more columns for each record.

Such as:

shop1|add1|citystate1|phone1|web1|shop2|add2|citystate2|phone2|web2| etc.

...with the data falling under the app开发者_开发问答ropriate columns. The columns are the same only sequential for each record.

Screen Shots

The datasource image is what the data looks like now. Except that I copied these columns out of the original because there were other columns. I just need those 5 columns.

The result image is how I need it to end up. There could be hundreds of records going across. The headers need to be sequential as shown. I have only included the first several columns but these extend horizontally several records.

---

    

            ^{Sample data}

A long vertical list of contact information would be most expediently handled by direct value transfer.

Sub moveShiftLaterally_Values()
    Dim strHDR As String, rw As Long, cls As Long, vHDRs As Variant

    strHDR = "shop0|add0|citystate0|phone0|web0"

    Worksheets("Sheet1").Copy After:=Worksheets("Sheet1")
    ActiveSheet.Name = "horizList"

    With Worksheets("horizList")
        For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
            'assign the correct increment and split the header string
            vHDRs = Split(Replace(strHDR, 0, rw - 1), Chr(124))
            'transfer the headers
            .Cells(1, 1).Offset(0, (rw - 2) * (UBound(vHDRs) + 1)).Resize(1, UBound(vHDRs) + 1) = vHDRs
            'transfer the values
            .Cells(2, 1).Offset(0, (rw - 2) * (UBound(vHDRs) + 1)).Resize(1, UBound(vHDRs) + 1) = _
                .Cells(rw, 1).Resize(1, UBound(vHDRs) + 1).Value
        Next rw
        'remove the original entries
        .Cells(1, 1).CurrentRegion.Offset(2, 0).Clear
    End With

End Sub

   

            ^{After moveShiftLaterally_Values}

However, with the possibility of custom number formatting for the phone numbers and varying column widths that should be homogenized horizontally, adding certain XlPasteType facets of the Range.PasteSpecial method to first seed the destination cells might ultimately prove to be the best method.

Sub moveShiftLaterally_All()
    Dim strHDR As String, rw As Long, cls As Long, vHDRs As Variant

    strHDR = "shop0|add0|citystate0|phone0|web0"

    Worksheets("Sheet1").Copy After:=Worksheets("Sheet1")
    ActiveSheet.Name = "horizList"

    With Worksheets("horizList")
        'seed the cell formats and column widths first
        With .Cells(1, 1).CurrentRegion
            With .Resize(2, .Columns.Count)
                .Copy
                For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
                    'transfer the column widths and cell formatting
                    .Cells(1, 1).Offset(0, (rw - 2) * .Columns.Count).PasteSpecial _
                      Paste:=xlPasteColumnWidths
                    .Cells(1, 1).Offset(0, (rw - 2) * .Columns.Count).PasteSpecial _
                      Paste:=xlPasteFormats
                Next rw
                Application.CutCopyMode = False
            End With
        End With
        'transfer the HDR and VALs
        For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
            'assign the correct increment and split the header string
            vHDRs = Split(Replace(strHDR, 0, rw - 1), Chr(124))
            'transfer the headers
            .Cells(1, 1).Offset(0, (rw - 2) * (UBound(vHDRs) + 1)).Resize(1, UBound(vHDRs) + 1) = vHDRs
            'transfer the values
            .Cells(2, 1).Offset(0, (rw - 2) * (UBound(vHDRs) + 1)).Resize(1, UBound(vHDRs) + 1) = _
                .Cells(rw, 1).Resize(1, UBound(vHDRs) + 1).Value
        Next rw
        'remove the original entries
        .Cells(1, 1).CurrentRegion.Offset(2, 0).Clear
    End With

End Sub

  

            ^{After moveShiftLaterally_Values}

I will leave it to you to decide which method suits your purpose.

---

The Concatenate function will probably do what you want.