Anzahl gefundene Zeilen

Private Sub CommandButton1_Click()
Dim i%, strAusgabe$
Dim Suchen As String
Dim ws As Worksheet
Dim LetzteZeile, LetzteSpalte As Integer
Dim sFirstAdress As String
Dim rng As Range
Set ws = Worksheets("Lagerliste_drucken")
With ListBox1
If .Selected(i) = False Then
MsgBox "Bitte Lagerort(e) auswählen!", vbInformation
Exit Sub
Else
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
Suchen = strAusgabe & .List(i)
Set rng = Worksheets("WSCAR_Daten").Range("F:F").Find(Suchen, _
LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
If rng Is Nothing Then
MsgBox "Lagerort " & Suchen & " nicht gefunden!", vbInformation
Else
If ws.Cells(1, 1) = "" Then
ws.Cells(1, 1) = "Lagerort " & Suchen
ws.Cells(1, 1).Borders.LineStyle = xlContinuous
ws.Cells(1, 1).Font.Bold = True
ws.Cells(2, 1) = "Vorname": ws.Cells(2, 2) = "Name": ws.Cells(2, 3) = "Marke"
ws.Cells(2, 4) = "Typ": ws.Cells(2, 5) = "Kontrollschild"
ws.Range(ws.Cells(2, 1), ws.Cells(2, 5)).Font.Bold = True
ws.Range(ws.Cells(2, 1), ws.Cells(2, 5)).Borders.LineStyle = xlContinuous
ws.Cells(1, 1).MergeArea.BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic
Else
LetzteZeile = ws.Cells(Rows.Count, 1).End(xlUp).Row
LetzteSpalte = ws.Cells(LetzteZeile, Columns.Count).End(xlToLeft).Column
ws.Cells(LetzteZeile + 2, 1) = "Lagerort " & Suchen
ws.Cells(LetzteZeile + 2, 1).Font.Bold = True
ws.Cells(LetzteZeile + 3, 1) = "Vorname": ws.Cells(LetzteZeile + 3, 2) = "Name": ws.Cells(LetzteZeile + 3, 3) = "Marke"
ws.Cells(LetzteZeile + 3, 4) = "Typ": ws.Cells(LetzteZeile + 3, 5) = "Kontrollschild"
ws.Range(ws.Cells(LetzteZeile + 3, 1), ws.Cells(LetzteZeile + 3, 5)).Font.Bold = True
ws.Range(ws.Cells(LetzteZeile + 3, 1), ws.Cells(LetzteZeile + 3, 5)).Borders.LineStyle = xlContinuous
ws.Cells(LetzteZeile + 2, 1).MergeArea.BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic
End If
sfirstaddress = rng.Address
Do
rng.Offset(0, -5).Resize(1, 5).Copy Destination:=Worksheets("Lagerliste_Drucken").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Set rng = Worksheets("WSCAR_Daten").Range("F:F").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address  sfirstaddress
End If
Else
End If
Next
End If
End With
End Sub