Thema: Aus einer Adressliste je 10 Adressen pro PLZ filtern

StandardModule: basMain

Sub FilternPLZ()
   Dim iRow As Integer, iCounter As Integer, iRowT As Integer
   Application.ScreenUpdating = False
   Columns("A:C").AdvancedFilter _
      Action:=xlFilterCopy, _
      CriteriaRange:=Range("E1").CurrentRegion, _
      CopyToRange:=Range("I1"), _
      Unique:=False
   Columns("I:K").Sort _
      Key1:=Range("K2"), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   iRow = Cells(Rows.Count, 11).End(xlUp).Row
   Columns("A:H").Delete
   Range("A:C").Copy Range("D:F")
   iRow = 2
   iRowT = 1
   Do Until IsEmpty(Cells(iRow, 3))
      Do Until Cells(iRow, 3).Value <> Cells(iRow + 1, 3).Value
         iCounter = iCounter + 1
         If iCounter <= 10 Then
            iRowT = iRowT + 1
            Range(Cells(iRowT, 4), Cells(iRowT, 6)).Value = _
               Range(Cells(iRow, 1), Cells(iRow, 3)).Value
         End If
      iRow = iRow + 1
      Loop
      iCounter = 0
      iRow = iRow + 1
   Loop
   Columns("A:C").Delete
End Sub

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Filtern