CODEWITHSUNDEEP
excelvbaloops
Tiago
Tiago

Reputation: 27

VBA - Copy and paste columns to a single column & then copy the according heading x times

My VBA skills are fresh as this is something I've been working on to improve.

I've searched and got some parts of coding, however, I cannot do what I need. (Each bar represents a cell on excel sheet

I understand this is not complicated, but I'm struggling when I need to count, copy and paste the headings according to the numbers of rows each of them has.

Regards.

Upvotes: 1

Views: 83

Answers (1)

Mrig
Mrig

Reputation: 11712

Assuming your data is in Sheet1 and you want result in Sheet2 try the following code:

Sub RangetoColumn()
    Dim lastRow As Long, lastColumn As Long
    Dim CurrentSheet As Worksheet, TargetSheet As Worksheet
    Dim i As Long, j As Long, Count As Long
    Dim colHeader As String

    Set CurrentSheet = ThisWorkbook.Worksheets("Sheet1")    '-->sheet with data
    Set TargetSheet = ThisWorkbook.Worksheets("Sheet2")     '-->sheet to display result
    lastColumn = CurrentSheet.Cells(1, Columns.Count).End(xlToLeft).Column

    Count = 1
    For i = 1 To lastColumn
        lastRow = CurrentSheet.Cells(Rows.Count, i).End(xlUp).Row
        If lastRow > 1 Then    '-->check for data below header
            colHeader = CurrentSheet.Cells(1, i).Value
            For j = 1 To lastRow - 1
                TargetSheet.Range("A" & Count).Value = colHeader
                TargetSheet.Range("B" & Count).Value = CurrentSheet.Cells(j + 1, i).Value
                Count = Count + 1
            Next j
        End If
    Next i
End Sub

Upvotes: 1

Related Questions