Macro para mostrar datos de varios items de listbox

-------------------------------

Hola
Necesito que me ayuden a completar un codigo que debe hacer lo siguiente
1. Tengo un combobox de donde selecciono cualquier dato
2. El dato seleccionado me muestra una lista en un listbox1
3. Con la opcion frmMultiSelectMulti selecciono varios items del listbox1
4. En el listbox2 se muestra los resultado del listbox1 pero solo se muestra de un solo item seleccionado
quiero que si selecciono dos, tres o cinco item (la cantidad que sea) se muestren los resultados de todos esos items al mismo tiempo en el listbox2
este es el codigo que uso

Private Sub ComboBox1_Change()
fi = 1
Me.ListBox1.Clear
If Me.ComboBox1.Value = Empty Then Exit Sub
'
Me.ListBox1.Clear
For i = 3 To Hoja19.Range("A" & Rows.Count).End(xlUp).Row
If LCase(Hoja19.Cells(i, 4).Value) Like "*" & LCase(Me.ComboBox1.Value) & "*" Then
existe = False
For j = 0 To ListBox1.ListCount - 1
If Hoja19.Cells(i, 3) = ListBox1.List(j, 0) Then
existe = True
Exit For
End If
Next
If existe = False Then
Me.ListBox1.AddItem Hoja19.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Hoja19.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = fi
fi = fi + 1
End If
End If
Next i
Me.ListBox2.Clear
End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Me.ListBox2.ColumnCount = 3
Me.ListBox2.ColumnWidths = "20 pt;275 pt;30 pt"

'Le digo cuántas columnas
ListBox1.ColumnCount = 3
'Asigno el ancho a cada columna
Me.ListBox1.ColumnWidths = "100 pt;50 pt;15 pt"
Dim LR&

Set ws1 = Sheets("Salidas")

Application.ScreenUpdating = False
With ws1
Set ws2 = Sheets("base")
Application.GoTo ws1.[a1]
LR = .Cells(Rows.Count, "a").End(xlUp).Row
ws2.[a1] = .[d2].Value
.Range("d2:d" & LR).AdvancedFilter 2, "", ws2.[a1], True
ws2.[a1].CurrentRegion.Sort ws2.[a1], xlAscending, Header:=xlYes
ComboBox1.List = ws2.[a1].CurrentRegion.Value
ComboBox1.RemoveItem 0

ws2.[e1] = ws2.[a1].Value
End With
Application.ScreenUpdating = True
Range("A3").Activate

End Sub
'
Private Sub ListBox1_Change()
Me.ListBox2.Clear
On Error Resume Next
f = 1

num = frm_Requi.ListBox1.List(frm_Requi.ListBox1.ListIndex, 0)
Set r = Hoja19.Columns("C")
Set b = r.Find(num, lookat:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
ListBox2.AddItem
ListBox2.List(ListBox2.ListCount - 1, 1) = Hoja19.Cells(b.Row, "A")
ListBox2.List(ListBox2.ListCount - 1, 2) = Hoja19.Cells(b.Row, "E")
ListBox2.List(ListBox2.ListCount - 1, 0) = f
f = f + 1
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If

End Sub

Sub ajustar()
Sheets("Salidas").Select
Range("A1:H1").Select 'Indicar el rango deseado
ActiveWindow.Zoom = True
End Sub