VBA copy & Paste loop from columns (B to G) to the last row of column A

Viewed 131

I need your help in create a VBA for copy loop.

I want to copy a range of data in column B to last row of A column and then copy next column C to the last row of column A.

enter image description here

enter image description here

1 Answers

Stack Columns

Option Explicit

Sub stackColumns()
    
    Const sCols As String = "B:G" ' Source Columns
    Const sFirst As Long = 1 ' Source First Row
    Const dCol As String = "A" ' Destination Column
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' adjust here
    
    Dim srg As Range: Set srg = ws.Columns(sCols)
    Dim dCell As Range: Set dCell = ws.Cells(ws.Rows.Count, dCol).End(xlUp)
    If Not IsEmpty(dCell) Then
        Set dCell = dCell.Offset(1)
    End If
    
    Dim crg As Range
    Dim crCount As Long
    Dim j As Long
    For j = 1 To srg.Columns.Count
        With srg.Columns(j)
            crCount = .Cells(.Rows.Count).End(xlUp).Row - sFirst + 1
            Set crg = .Resize(crCount).Offset(sFirst - 1)
        End With
        dCell.Resize(crCount).Value = crg.Value
        Set dCell = dCell.Offset(crCount)
    Next j

End Sub
Related