Adapt VBA Code With Adjusment Range

[Admin]

Hi

May be..

Sub kTest()
    
    Dim rngData     As Range
    Dim rngName     As Range
    Dim rngDest     As Range
    Dim r           As Long
    Dim c           As Long
    Dim p           As Long
    Dim Ofset       As Long
    
    Ofset = 7
    
    With Sheet1
        p = .Range("c" & .Rows.Count).End(xlUp).Row
        Set rngName = .Range("c2:c" & p)
        Set rngData = .Range("aj2:at" & p)
    End With
    
    Set rngDest = Sheet2.Range("d32")
    
    For r = 1 To rngName.Rows.Count
        If Not rngName.Cells(r, 1).Value = vbNullString Then
            rngDest = rngName.Cells(r, 1)
            For c = 1 To rngData.Columns.Count
                If Not rngData.Cells(r, c).Value = vbNullString Then
                    rngDest.Offset(, Ofset) = rngData.Cells(r, c).Value2
                    rngDest = rngName.Cells(r, 1)
                    Set rngDest = rngDest.Offset(1)
                Else
                    If c = 1 Then Set rngDest = rngDest.Offset(1)
                    Exit For
                End If
            Next
        End If
    Next
    
End Sub