Merge columns to last column

Question

I would like to merge column X,Y,Z to last column at AF.

Currently, the code that I have below, merges the columns to AA. How can I modify it to get the intended results at AF (without clearing original contents at X,Y,Z) ?

ActiveCell.Offset(1, 26).Activate
Do While ActiveCell.Row <= NewLastRow
    CurPos = ActiveCell.Address
    If ActiveCell = "" Then
        ActiveCell = "=RC[-3]&"" ""&RC[-2]&"" ""&RC[-1]"
        ActiveCell.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        ActiveSheet.Paste
        Application.CutCopyMode = False
    Else
    End If
Loop

Answer 1

Concatenate Columns

Sub ConcatColumns()
    
    Const sFirstRowAddress As String = "X2:Z2"
    Const dFirstCellAddress As String = "AF2"
    Const Delimiter As String = " "
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim Data As Variant
    Dim rCount As Long
    Dim cCount As Long
    
    ' Write the source range values to an array.
    With ws.Range(sFirstRowAddress)
        Dim lCell As Range: Set lCell = .Resize(ws.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Sub ' no data in range
        rCount = lCell.Row - .Row + 1
        cCount = .Columns.Count
        Data = .Resize(lCell.Row - .Row + 1).Value
    End With
    
    Dim dLen As Long: dLen = Len(Delimiter)
    
    Dim r As Long
    Dim c As Long
    Dim cString As String
    
    ' Write the concatenated values to the first column of the array.
    For r = 1 To rCount
        For c = 1 To cCount
            cString = cString & CStr(Data(r, c)) & Delimiter
        Next c
        Data(r, 1) = Left(cString, Len(cString) - dLen)
        cString = vbNullString
    Next r
    
    ' Write the array's first column values to the destination column.
    With ws.Range(dFirstCellAddress)
        .Resize(rCount).Value = Data
    End With
    
End Sub