ich suche den ganzen Tag schon nach einer Lösung.
Ich habe eine UF mit Combobox1 und Listbox1.
Mit Combobox1 wähle ich einen Wert aus zum Filtern. Mit Commandbutton3 übernehme ich die gefilterten Daten in die Listbox1. Code hierfür angefügt:
Private Sub CommandButton3_Click()
Dim lz As Long 'für Filter
Dim lLetzte As Long 'für Listbox
Dim lZeile As Long 'für Listbox
Dim lLibox As Long 'für Listbox
Dim Wert As String 'für Filter
Dim wks As Worksheet
Set wks = ActiveSheet
Wert = Me.ComboBox1.Value
With wks
If .AutoFilterMode = True Then
If .FilterMode = True Then .ShowAllData
Else
lz = .Cells(Rows.Count, 1).End(xlUp).Row 'LastZell in Tabelle1 ermitteln
.Range("$A$1:$D$" & lz).AutoFilter
.Range("$A$1:$D$" & lz).AutoFilter Field:=4, Criteria1:=Wert
End If
End With
With Me.ListBox1
.ColumnCount = 4
.Font.Size = 9
.MultiSelect = fmMultiSelectMulti
.ColumnWidths = "3cm;3cm;3cm;3cm"
End With
With Worksheets("Tabelle1")
lLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
For lZeile = 2 To lLetzte
If .Cells(lZeile, 1) = "" Then Exit For
If .Rows(lZeile).Hidden = False Then
ListBox1.AddItem
ListBox1.List(lLibox, 0) = .Cells(lZeile, 1).Value
ListBox1.List(lLibox, 1) = .Cells(lZeile, 2).Value
ListBox1.List(lLibox, 2) = .Cells(lZeile, 3).Value
ListBox1.List(lLibox, 3) = .Cells(lZeile, 4).Value
lLibox = lLibox + 1
End If
Next
End With
''' wks.UsedRange.AutoFilter
'''wks.Range("$A$1:$D$" & lz).AutoFilter
End Sub
Was ich jetzt bitte benötige ist, die ausgewählten Daten der Multiselect Listbox in die Tabelle2 zu kopieren in Zelle A2.
Besten Dank für eure Hilfe.
Gruss
Peter