none
Multipy text colums vba RRS feed

  • Question

  • Hi All

    How can I transform via VBA my source data:

    Let's say Country is in a column A, Spread in a column B of the Sheet1

    Country
    UK
    DE
    IT
    ...

    Spread
    2
    4
    6

    to get the one which looks like this:

    Country Spread
    UK 2
    UK 4
    UK 6
    DE 2
    DE 4
    DE 6
    IT 2
    IT 4
    IT 6

    I prefer this to happen in the ActiveSheet


    Monday, September 21, 2015 2:48 PM

Answers

  • With your headers in row 1 of the activesheet:

    Sub TestMacro()
        Dim lRow As Long
        Dim lA As Long
        Dim lB As Long
        Dim C As Range
        
        lRow = ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Cells.Count).Row
        
        lA = Cells(Rows.Count, "A").End(xlUp).Row
        lB = Cells(Rows.Count, "B").End(xlUp).Row
        
        For Each C In Range("A2:A" & lA)
            C.Copy Cells(lRow + 1 + (C.Row - 2) * (lB - 1), "A").Resize(lB - 1)
        Next C
        
        Range("B2:B" & lB).Copy Cells(lRow + 1, "B").Resize((lA - 1) * (lB - 1))
        Range("A2:A" & lRow).EntireRow.Delete
        
    End Sub
    Monday, September 21, 2015 7:25 PM

All replies

  • With your headers in row 1 of the activesheet:

    Sub TestMacro()
        Dim lRow As Long
        Dim lA As Long
        Dim lB As Long
        Dim C As Range
        
        lRow = ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Cells.Count).Row
        
        lA = Cells(Rows.Count, "A").End(xlUp).Row
        lB = Cells(Rows.Count, "B").End(xlUp).Row
        
        For Each C In Range("A2:A" & lA)
            C.Copy Cells(lRow + 1 + (C.Row - 2) * (lB - 1), "A").Resize(lB - 1)
        Next C
        
        Range("B2:B" & lB).Copy Cells(lRow + 1, "B").Resize((lA - 1) * (lB - 1))
        Range("A2:A" & lRow).EntireRow.Delete
        
    End Sub
    Monday, September 21, 2015 7:25 PM
  • Perfect!

    Thanks Bernie

    Tuesday, September 22, 2015 8:03 AM