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

i have 5 columns in data source need pull:
line1|line2|line3|line4|line5

...all data under them. need pull 5 columns new sheet , not rename them, create more columns each record.

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

...with data falling under appropriate columns. columns same sequential each record.

screen shots

the datasource image data looks now. except copied these columns out of original because there other columns. need 5 columns.

the result image how need end up. there hundreds of records going across. headers need sequential shown. have included first several columns these extend horizontally several records.

    
            ^{sample data}

a long vertical list of contact information expediently handled direct value transfer.

sub moveshiftlaterally_values()     dim strhdr string, rw long, cls long, vhdrs variant      strhdr = "shop0|add0|citystate0|phone0|web0"      worksheets("sheet1").copy after:=worksheets("sheet1")     activesheet.name = "horizlist"      worksheets("horizlist")         rw = .cells(rows.count, 1).end(xlup).row 2 step -1             'assign correct increment , split header string             vhdrs = split(replace(strhdr, 0, rw - 1), chr(124))             'transfer headers             .cells(1, 1).offset(0, (rw - 2) * (ubound(vhdrs) + 1)).resize(1, ubound(vhdrs) + 1) = vhdrs             'transfer 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 original entries         .cells(1, 1).currentregion.offset(2, 0).clear     end  end sub 

   
            ^{after moveshiftlaterally_values}

however, possibility of custom number formatting phone numbers , varying column widths should homogenized horizontally, adding xlpastetype facets of range.pastespecial method first seed destination cells might prove best method.

sub moveshiftlaterally_all()     dim strhdr string, rw long, cls long, vhdrs variant      strhdr = "shop0|add0|citystate0|phone0|web0"      worksheets("sheet1").copy after:=worksheets("sheet1")     activesheet.name = "horizlist"      worksheets("horizlist")         'seed cell formats , column widths first         .cells(1, 1).currentregion             .resize(2, .columns.count)                 .copy                 rw = .cells(rows.count, 1).end(xlup).row 3 step -1                     'transfer column widths , 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         end         'transfer hdr , vals         rw = .cells(rows.count, 1).end(xlup).row 2 step -1             'assign correct increment , split header string             vhdrs = split(replace(strhdr, 0, rw - 1), chr(124))             'transfer headers             .cells(1, 1).offset(0, (rw - 2) * (ubound(vhdrs) + 1)).resize(1, ubound(vhdrs) + 1) = vhdrs             'transfer 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 original entries         .cells(1, 1).currentregion.offset(2, 0).clear     end  end sub 

              ^{after moveshiftlaterally_values}

i leave decide method suits purpose.