Transfer Specific Column From ListBox Userform

[IoanZ]

Hello everyone
Please help me

I use this code to transfer in cell D1/E1/F1 the selected values from listbox userform.
With this code i can transfer all columns from selected row

Which is vba code to transfer in cell D1/E1 only the first and third columns of selected row from listbox.
(i want to put in cell D1 Num value and in cell E1 Day value)
Image of sheet.
https://imgur.com/a/vwecgqX

Thanks a lot

Private Sub TransferButton_Click()
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 Sheet1.Range("D1", Sheet1.Cells(lRows + 1, 4 + lCols)) 'Transfer to range
.Cells.Clear 'Clear transfer range
For lItem = 0 To lRows
If ListBox1.Selected(lItem) = True Then 'Row selected
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

 

[DanteAmor]

Try this:

Private Sub TransferButton_Click()
    If ListBox1.ListIndex = -1 Then
        MsgBox "Nothing chosen", vbCritical
    Else
        Sheet1.Range("D1").Value = ListBox1.List(ListBox1.ListIndex, 0)
        Sheet1.Range("E1").Value = ListBox1.List(ListBox1.ListIndex, 2)
        MsgBox "Transferred data", vbInformation
    End If
End Sub

 

[IoanZ]

work's thank's

 

[IoanZ]

I found this code and works fine (for multiple selection from listbox

Private Sub CommandButton6_Click()
Dim lngItem As Long
For lngItem = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(lngItem) Then
With Sheets(1) '< qualify sheet here
.Cells(Range("C423").End(xlUp).Row + 1, 3).Value = ListBox2.List(lngItem, 0)
.Cells(Range("D423").End(xlUp).Row + 1, 4).Value = ListBox2.List(lngItem, 2)
End With
End If
Next lngItem
Unload Me
ActiveSheet.Calculate
End Sub

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.