Hallo
Ich habe eine Listbox die Funktioniert hat.
Leider musste ich die Tabelle etwas abändern und seid dem funktioniert diese nicht mehr.
Diese bestand aus Spalte A, B und C
Da ich den Kopf ändern mußte habe ich nun Spalte A, B, C, D, E, F, G und H.
Spalte B bis G habe ich miteinander verbunden.
Leider klappt nun die Listbox nicht mehr.
Was muß ich ändern, damit dieser wieder funzt?
Hier mal der Code:
Private Sub cmdOK_Click()
Dim lngI As Long, lngNext As Long, rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
With Sheets("Listbox1")
For lngI = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lngI) Then
If rng1 Is Nothing Then
Set rng1 = .Cells(lngI + 1, 1)
Else
Set rng1 = Union(rng1, .Cells(lngI + 1, 1))
End If
End If
Next
End With
With Sheets("Listbox2")
For lngI = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(lngI) Then
If rng2 Is Nothing Then
Set rng2 = .Cells(lngI + 1, 1)
Else
Set rng2 = Union(rng2, .Cells(lngI + 1, 1))
End If
End If
Next
End With
With Sheets("Listbox3")
For lngI = 0 To ListBox3.ListCount - 1
If ListBox3.Selected(lngI) Then
If rng3 Is Nothing Then
Set rng3 = .Cells(lngI + 1, 1)
Else
Set rng3 = Union(rng3, .Cells(lngI + 1, 1))
End If
End If
Next
End With
With Sheets("Listbox4")
For lngI = 0 To ListBox4.ListCount - 1
If ListBox4.Selected(lngI) Then
If rng4 Is Nothing Then
Set rng4 = .Cells(lngI + 1, 1)
Else
Set rng4 = Union(rng4, .Cells(lngI + 1, 1))
End If
End If
Next
End With
With Sheets("Fahrzeugbegleitkarte")
If Not rng1 Is Nothing Then rng1.Copy .Cells(15, 2)
lngNext = Application.Max(11, .Cells(.Rows.Count, 2).End(xlUp).Row + 1)
If Not rng2 Is Nothing Then rng2.Copy .Cells(lngNext, 2)
lngNext = Application.Max(11, .Cells(.Rows.Count, 2).End(xlUp).Row + 1)
If Not rng3 Is Nothing Then rng3.Copy .Cells(lngNext, 2)
lngNext = Application.Max(11, .Cells(.Rows.Count, 2).End(xlUp).Row + 1)
If Not rng4 Is Nothing Then rng4.Copy .Cells(lngNext, 2)
Unload Me
End With
Set rng1 = Nothing
Set rng2 = Nothing
Set rng3 = Nothing
Set rng4 = Nothing