TRANSFER DATA DARI LISTBOX KE CELL MACRO VBA

Transfer data dari ListBox ke Cell

dari data listbox yang sudah ada tinggal buat button untuk transfer dari listboxnya ke cell

Berikut Macronya :

Private Sub CommandButton1_Click() 'pilih data

Dim Litem As Long, lRows As Long, lCols As Long
 Dim bSelected As Boolean
 Dim lColLoop As Long, lTransferRow As Long
 lRows = ListBox1.ListCount - 1
 lCols = ListBox1.ColumnCount - 1
    For Litem = 0 To lRows

        If ListBox1.Selected(Litem) = True Then

            bSelected = True

            Exit For
        End If
    Next
    
    If bSelected = True Then
        With Sheet6.Range("C2", Sheet6.Cells(lRows + 1, 4 + lCols))
            .Cells.Clear
            For Litem = 0 To lRows
                If ListBox1.Selected(Litem) = True Then

                  lTransferRow = lTransferRow + 1
      
                    For lColLoop = 0 To lCols

                       .Cells(lTransferRow, lColLoop + 1) = ListBox1.List(Litem, lColLoop)

                    Next lColLoop
                End If
            Next
        End With
    Else '
         MsgBox "Nothing chosen", vbCritical
    End If

End Sub