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