Переместите 5 столбцов с одного листа на другой, но поместите в один ряд

Question

У меня есть 5 столбцов в источнике данных, которые мне нужно вытащить:
Line1|Line2|Line3|Line4|Line5

... все с данными под ними.Мне нужно вытянуть эти 5 столбцов на новый лист и не только переименовать их, но и создать больше столбцов для каждой записи.

Например:
shop1|add1|citystate1|phone1|web1|shop2|add2|citystate2|phone2|web2| etc.

...данные попадают под соответствующие столбцы.Столбцы одинаковы, только последовательно для каждой записи.

Снимки экрана

Изображение источника данных - это то, как данные выглядят сейчас.За исключением того, что я скопировал эти столбцы из оригинала, потому что были другие столбцы.Мне просто нужны эти 5 столбцов.

В результате получается то, как мне это нужно в итоге.Там могут быть сотни записей.Заголовки должны быть последовательными, как показано.Я включил только первые несколько столбцов, но они расширяют по горизонтали несколько записей.

Answer 1

^{Пример данных}

Длинный вертикальный список контактной информации наиболее целесообразно обрабатывать путем прямой передачи значения.

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

^{После перемещенияShiftLaterally_Values ​​}

Однако, с возможностью пользовательского форматирования номеров для телефонных номеров и различной ширины столбца, которые должны быть гомогенизированы по горизонтали, добавление определенных XlPasteType фасетов Range.PasteSpecial метода к первому засадить ячейки назначения в конечном итоге может оказаться лучшим методом.

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

^{После перемещенияShiftLaterally_Values ​​}

Я оставлю вам решать, какой метод соответствует вашим целям.

Answer 2

Функция Concatenate , вероятно, сделает то, что вы хотите.