Banner

Monday, May 24, 2021

Listbox Data Transfer To Particular Sheet Excel VBA

 Listbox Data Transfer To Particular Sheet Excel VBA

Listbox Data Transfer To Particular Sheet Excel VBA


Watch Video

VBA Code

Private Sub ComboBox1_Change() 'Combobox
For c = 1 To Me.ListBox1.ListCount - 1
If Format(Me.ListBox1.List(c, 0), "M") = Val(Me.ComboBox1.ListIndex) + 1 Then
Me.ListBox1.Selected(c) = True
End If
Next c
Me.CommandButton2.Enabled = True
End Sub

Private Sub CommandButton2_Click()  'Custom Transfer
Dim i As Long, MNT As Integer
Application.ScreenUpdating = False
For i = 1 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) = True Then
MNT = Format(Me.ListBox1.List(i), "M")
Sheets(MNT + 1).Range("A1000000").End(xlUp).Offset(1, 0) = Me.ListBox1.List(i, 0)
Sheets(MNT + 1).Range("A1000000").End(xlUp).Offset(0, 1) = Me.ListBox1.List(i, 1)
Sheets(MNT + 1).Range("A1000000").End(xlUp).Offset(0, 2) = Me.ListBox1.List(i, 2)
Sheets(MNT + 1).Range("A1000000").End(xlUp).Offset(0, 3) = Me.ListBox1.List(i, 3)
End If
Me.ListBox1.Selected(i) = False
Next i
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton3_Click()  'Transfer All
Dim i As Long, MNT As Integer
Application.ScreenUpdating = False
For i = 1 To Me.ListBox1.ListCount - 1
MNT = Format(Me.ListBox1.List(i), "M") + 1
With Sheets(MNT).Range("A1000000").End(xlUp)
On Error Resume Next
.Offset(1, 0) = Me.ListBox1.List(i, 0)
.Offset(1, 1) = Me.ListBox1.List(i, 1)
.Offset(1, 2) = Me.ListBox1.List(i, 2)
.Offset(1, 3) = Me.ListBox1.List(i, 3)
End With
Next i
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton4_Click()   'Unselect
Dim i As Integer
For i = 1 To Me.ListBox1.ListCount - 1
Me.ListBox1.Selected(i) = False
Next i
Me.CommandButton2.Enabled = False
End Sub
Private Sub ListBox1_Enter()
Me.CommandButton2.Enabled = True
End Sub

Private Sub UserForm_Initialize() 'Listbox Fill
Dim i As Long
For i = 1 To Sheet1.Range("A1000000").End(xlUp).Row
Me.ListBox1.AddItem
For c = 1 To 4
On Error Resume Next
Me.ListBox1.List(i - 1, c - 1) = Sheet1.Cells(i, c)
Next c
Next i
Me.ListBox1.Selected(0) = True

For x = 1 To Worksheets.Count   'Combobox Fill
Me.ComboBox1.AddItem MonthName(x)
Next x
End Sub

Private Sub CommandButton2_Click()   'Clear Worksheet
Dim i As Long, MNT As Integer
Application.ScreenUpdating = False
For MNT = 2 To Worksheets.Count
For i = 2 To Sheets(MNT).Range("A1000000").End(xlUp).Row
Sheets(MNT).Range("A" & 2, "D" & i).ClearContents
Next i
Next MNT
Application.ScreenUpdating = True
End Sub






No comments:

Post a Comment

Please do not enter any spam message in comment box