none
Automatically move Excel rows into columns? RRS feed

  • Question

  • I have several spreadsheets that look like this:

    Name

    Address

    City

    Jim

    Main Street

    New York

    Jane

    Elm Avenue

    Boston

     

    Is there a tool or macro that will automatically reformat to this?

    Name

    Jim

    Address

    Main Street

    City

    New York

     

     

    Name

    Jane

    Address

    Elm Avenue

    City

    Boston

     

    The Transpose function doesn't give me the format I need.

    • Edited by JJ1966 Friday, May 29, 2015 3:26 PM
    Friday, May 29, 2015 3:16 PM

Answers

  • This looked like a fun little challenge. 

    I couldn't resist.

    Sub CopyPaste()
    Dim shA As Worksheet
    Dim shB As Worksheet
    Dim LastRow As Long
    Dim r As Long
    Dim Item As String
    
    Set shA = Worksheets("Sheet1") 'Change to suit
    Set shB = Worksheets("Sheet2") 'Change to suit
    
    LastRow = shA.Range("A1").End(xlDown).Row
    
    
    For rw = 2 To LastRow
    Item = shA.Cells(rw, 1)
    r = r + 1
    
    shB.Range("A" & r & ":A" & r + 1) = "Name"
    shB.Range("A" & r + 1 & ":A" & r + 1) = "Address"
    shB.Range("A" & r + 2 & ":A" & r + 2) = "City"
    
    shB.Range("B" & r & ":B" & r + 1) = Item
    shB.Cells(r + 1, 2) = shA.Cells(rw, 2)
    r = r + 1
    shB.Cells(r + 1, 2) = shA.Cells(rw, 3)
    r = r + 1
    
    Next
    End Sub
    


    Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.

    Friday, May 29, 2015 6:06 PM