Adapt VBA Code With Adjusment Range

[muhammad susanto]

hii expert...

would you help me to easy adapt this code which expected result in "sheet2" start from range "k16" drop down
with source data in sheet "data" and with title/column name as parameter...

i confused to figure it out, and i 'am newbie

Sub result()
Dim lstRow As Long
Dim i As Long
Application.ScreenUpdating = False
Sheet2.Range("B2:C500").Value = "" 'Change as required
Sheet1.Activate
lstRow = Range("C" & Rows.Count).End(xlUp).Row
For i = 2 To lstRow
    If Range("C" & i).Value <> "" Then
    Sheet2.Cells(Rows.Count, Range("B1").Column).End(xlUp).Offset(1, 0).Value _
    = Sheet1.Range("C" & i).Value
    End If
    If Range("D" & i).Value <> "" Then
    Sheet2.Cells(Rows.Count, Range("C1").Column).End(xlUp).Offset(1, 0).Value _
    = Sheet1.Range("D" & i).Value
    End If
    If Range("E" & i).Value <> "" Then
    Sheet2.Cells(Rows.Count, Range("B1").Column).End(xlUp).Offset(1, 0).Value _
    = Sheet1.Range("C" & i).Value
    Sheet2.Cells(Rows.Count, Range("C1").Column).End(xlUp).Offset(1, 0).Value _
    = Sheet1.Range("e" & i).Value
    End If
    If Range("F" & i).Value <> "" Then
    Sheet2.Cells(Rows.Count, Range("B1").Column).End(xlUp).Offset(1, 0).Value _
    = Sheet1.Range("C" & i).Value
    Sheet2.Cells(Rows.Count, Range("C1").Column).End(xlUp).Offset(1, 0).Value _
    = Sheet1.Range("F" & i).Value
    End If
    If Range("D" & i).Value = "" Then
    Sheet2.Cells(Rows.Count, Range("C1").Column).End(xlUp).Offset(1, 0).Value _
    = "-"
    End If
Next i
Sheet2.Activate
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "I think now you are happy after see your desired Answer" 
End Sub

for anybody help me, much appreciated...
i attach woorbook


regards..
m.susanto

[muhammad susanto]

if you are confused. i attach new workbook with show the results completely...

i hope somebody would help me to make me happy......

[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