Hallo zusammen!

Ich bräuchte Hilfe bei einem Makro, welches mir riesen Datenmengen strukturiert. Dabei handelt es sich um Umzugsdaten, wobei je nach Bundesland die jeweiligen Kreise in alle Kreise Deutschlands nach Altersgruppen sortiert sind. Je nachdem eben, ob jmd. von diesem Kreis in den anderen gezogen ist. Entsprechend ist die Struktur nicht vollständig. Ich brauche aber eine komplette Struktur von jedem Kreis in jeden Kreis je Altersgruppe. Dafür dann das Makro. Ich habe bereits eines, das an sich auch funktioniert und mir meine Tabellen sortiert (mittels einlesen der jeweiligen Kreisdaten (ist ja je Bundesland anders, deswegen auch dynamisch festgelegt) und 3er-Schleife; dann werden in einer Spalte diese Zeilen nummeriert, fehlt ein Kreis oder eine Altersgruppe wird schlichtweg eine Leerzeile mit der entsprechenden fortlaufenden Nummer unten angefügt, später sortier ich sie nach der Spalte und hab meine Struktur), ABER - jetzt das Problem - hin und wieder kommt es vor, dass er mir zwar die Alterklasse richtig sortiert aber in den vorherigen Zielkreis hinein. Der eigentliche Zielkreis ist mit 6 Leerzeilen vorhanden, nur steht dann eben die schon vorhandene Zeile im falschen Kreis.

So sieht es richtig aus:

 und so sieht es eben falsch aus:

Und da ich das nicht "per Hand" überprüfen und korrigieren kann, da es sich um 70 Tabellen handelt mit im Schnitt je 40.000 Zeilen, wäre es toll, wenn mir da jemand beim Makro helfen könnte.

Hier das Makro:

Option Explicit
Option Base 1 'Datenfelder werden ab 1 gezählt

Public Const anzAltersgruppen = 6
'Public Const anzZielKreise = 413
'Public Const anzHerkKreise = 44

Sub WanderungsDatenStrukturieren()

'Die Prozedur strukturiert unvollständige Datensätze
'enstprechend Randinformationen um.

Dim StrSteuersheet As String
Dim StrKreissheet As String
Dim IntHerkunfskreisSpalte As Integer
Dim IntZielkreisSpalte As Integer
Dim IntAltersgruppeSpalte As Integer
Dim IntSortierKriteriumAltersgruppe As Integer
Dim IntErsteZeiteDatensheet As Integer
Dim intEndzeileDatensheet As Integer
Dim StrAltersgruppen() As String
Dim IntAltersgruppen() As Integer
Dim LngAltersgruppenFehlend() As Long
Dim StrKreisSchluesselZiel() As String
Dim StrKreisSchluesselHerk() As String
Dim IntAnzHerkunftskreiseLeer As Integer

Dim anzZielKreise As Integer
Dim anzHerkKreise As Integer

Dim IntAltersgruppeErg As Integer
Dim LngAltersgruppenEintrag As Long

Dim i As Integer
Dim i2 As Integer
Dim i3 As Integer
Dim izeile As Long
Dim ifehl As Integer
Dim idurchlauf As Integer
Dim iadd As Integer
Dim iendzeile As Long
Dim ialter As Long
Dim ikreisZiel As Integer
Dim ikreisHerk As Integer

'Rahmenwerte setzen
StrSteuersheet = "Steuer"
Sheets(StrSteuersheet).Select
StrKreissheet = Range("C11")
anzHerkKreise = Range("C13")
anzZielKreise = Range("C14")
IntErsteZeiteDatensheet = Range("C15")
intEndzeileDatensheet = Range("C16")
IntHerkunfskreisSpalte = Range("C17")
IntZielkreisSpalte = Range("C18")
IntAltersgruppeSpalte = Range("C19")
IntSortierKriteriumAltersgruppe = Range("C20")
LngAltersgruppenEintrag = 0
iadd = 10
ialter = IntErsteZeiteDatensheet

ReDim StrAltersgruppen(anzAltersgruppen) As String
ReDim IntAltersgruppen(anzAltersgruppen) As Integer
ReDim LngAltersgruppenFehlend(anzAltersgruppen) As Long
ReDim StrKreisSchluesselZiel(anzZielKreise) As String
ReDim StrKreisSchluesselHerk(anzHerkKreise) As String


'Einlesen Altersgruppen
Sheets(StrSteuersheet).Select
Range("C3").Select
For i = 1 To anzAltersgruppen
    StrAltersgruppen(i) = Cells(i + 2, 3)
    IntAltersgruppen(i) = i
Next

'Einlesen Kreisschluessel Herkunftskreis
Sheets(StrSteuersheet).Select
Range("F3").Select
For i = 1 To anzHerkKreise
    StrKreisSchluesselHerk(i) = Cells(i + 2, 6)
    Debug.Print StrKreisSchluesselHerk(i)
Next

'Einlesen Kreisschluessel Zielkreis
Sheets(StrSteuersheet).Select
Range("G3").Select
For i = 1 To anzZielKreise
    StrKreisSchluesselZiel(i) = Cells(i + 2, 7)
Next

Sheets(StrKreissheet).Select
Cells(IntErsteZeiteDatensheet, IntSortierKriteriumAltersgruppe).Select
iendzeile = intEndzeileDatensheet 'Läufer für die Endzeile wird initialisiert
izeile = IntErsteZeiteDatensheet
'*** Alle Herkunftskreis, alleZielkreis, unterschiedliche Altersgruppen *****
For ikreisHerk = 1 To anzHerkKreise
  '*** Ein Herkunftskreis, alleZielkreis, unterschiedliche Altersgruppen *****
  If Cells(izeile, IntHerkunfskreisSpalte) = StrKreisSchluesselHerk(ikreisHerk) Then
    'Es geht weiter
    ikreisZiel = 1
    'izeile = IntErsteZeiteDatensheet
    'Cells(IntErsteZeiteDatensheet, IntSortierKriteriumAltersgruppe).Select
    For ikreisZiel = 1 To anzZielKreise
        'Kreis idendifizieren -> Prüfung, ob vorhanden, sondern durch Leerzeilen ersetzen StrKreisSchluesselZiel
        'Ist der Kreisschlüssel für diese Zeile tatsächlich der richtige Schlüssel aus der Reihenfolge der Kreisschlüssel?
        If Cells(izeile, IntZielkreisSpalte) = StrKreisSchluesselZiel(ikreisZiel) Then
            'Altersgruppenarbeit kann beginnen
            'Pro Kreis
            '*** Ein Herkunftskreis, ein Zielkreis, unterschiedliche Altersgruppen *****
            'pro idealer Altersgruppe, es werden die Indices 1 - 6 durchlaufen
            'izeile = IntErsteZeiteDatensheet
            For i = 1 To anzAltersgruppen
                LngAltersgruppenFehlend(i) = 0
            Next
            ifehl = 1
            idurchlauf = 1
            For i = 1 To 6
                'Altersgruppe für aktuelle Zelle ermitteln
                'Letzte Zeile erreicht, Prozedur wird verlassen
                If IsNull(CStr(Cells(izeile, IntAltersgruppeSpalte))) Then Exit Sub
                IntAltersgruppeErg = Altersgruppe2Zahl(CStr(Cells(izeile, IntAltersgruppeSpalte)))
                If IntAltersgruppeErg < idurchlauf Then
                   'nächsten Gruppe ist dran, es fehlen aber noch Werte
                   'Restliche Werte in den das Fehlend - Datenfeld
                   For i2 = i To anzAltersgruppen
                       LngAltersgruppenFehlend(ifehl) = i2 + LngAltersgruppenEintrag
                       ifehl = ifehl + 1
                   Next
                   Exit For
                End If
                'Falls Fehlerwert in der Altersgruppe, d.h. irgendein unbekanntes Zeichen bei den Altersgruppen
                'wird die Prozedur verlassen
                If IntAltersgruppeErg = 99 Then Exit Sub
        
                'vorhandene Altersgruppen werden eingetragen, nicht vorhandene gemerkt
                If IntAltersgruppeErg = i Then
                   'Altersgruppe vorhanden
                   Cells(izeile, IntSortierKriteriumAltersgruppe) = IntAltersgruppeErg + LngAltersgruppenEintrag
                   izeile = izeile + 1
                Else
                   'Altersgruppe nicht vorhanden
                   LngAltersgruppenFehlend(ifehl) = i + LngAltersgruppenEintrag
                   ifehl = ifehl + 1
                End If
                idurchlauf = idurchlauf + 1
                'Cells (IntErsteZeiteDatensheet + i)
            Next

            'restliche Altersgruppen ausgeben
            For i = 1 To ifehl - 1
                Cells(iendzeile, IntSortierKriteriumAltersgruppe) = LngAltersgruppenFehlend(i)
                iendzeile = iendzeile + 1
            Next
            LngAltersgruppenEintrag = LngAltersgruppenEintrag + iadd
        Else
             'Dieser Kreis existiert nicht
             'Leerzeilen einfügen
             'MsgBox "Den Zielkreis mit dem Kreisindex " & ikreisZiel & " gibt es nicht! Für Kreis xy werden sechs Zeilen eingefügt."
             Rows(izeile & ":" & izeile + 5).Select
             Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
             Cells(izeile, IntSortierKriteriumAltersgruppe) = LngAltersgruppenEintrag + 1
             Cells(izeile + 1, IntSortierKriteriumAltersgruppe) = LngAltersgruppenEintrag + 2
             Cells(izeile + 2, IntSortierKriteriumAltersgruppe) = LngAltersgruppenEintrag + 3
             Cells(izeile + 3, IntSortierKriteriumAltersgruppe) = LngAltersgruppenEintrag + 4
             Cells(izeile + 4, IntSortierKriteriumAltersgruppe) = LngAltersgruppenEintrag + 5
             Cells(izeile + 5, IntSortierKriteriumAltersgruppe) = LngAltersgruppenEintrag + 6
             izeile = izeile + 6
             LngAltersgruppenEintrag = LngAltersgruppenEintrag + iadd
             iendzeile = iendzeile + anzAltersgruppen
        End If
    Next 'Ende Ebene Zielkreis
  Else
    'Herkunftskreis ist nicht vorhanden
    'Leerzeilen einfügen
    IntAnzHerkunftskreiseLeer = anzAltersgruppen * anzZielKreise
    MsgBox "Den Herkunftskreis mit dem Kreisindex " & ikreisZiel & " gibt es nicht! Für Kreis xy werden sechs * " & anzZielKreise & " eingefügt. Dies sind " & IntAnzHerkunftskreiseLeer & " Zeilen."
    Rows(izeile & ":" & izeile + IntAnzHerkunftskreiseLeer - 1).Select
    Debug.Print
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Debug.Print
    For i2 = 1 To IntAnzHerkunftskreiseLeer
        For i3 = 1 To anzAltersgruppen
            Cells(izeile, IntSortierKriteriumAltersgruppe) = LngAltersgruppenEintrag + i3
            izeile = izeile + 1
        Next
        LngAltersgruppenEintrag = LngAltersgruppenEintrag + iadd
        i2 = i2 + anzAltersgruppen
    Next
    iendzeile = iendzeile + IntAnzHerkunftskreiseLeer
  End If

Next 'Ende Ebene Herkunftkreise

End Sub
Public Function Altersgruppe2Zahl(StrAltersgruppe As String) As Integer

'Wandelt eine gegebene Altergruppen in die zugehörige Ordnungszahlzahl um

Select Case StrAltersgruppe
Case "unter 18"
    Altersgruppe2Zahl = 1
Case "18 - 25"
    Altersgruppe2Zahl = 2
Case "25 - 30"
    Altersgruppe2Zahl = 3
Case "30 - 50"
    Altersgruppe2Zahl = 4
Case "50 - 65"
    Altersgruppe2Zahl = 5
Case "65 und älter"
    Altersgruppe2Zahl = 6
Case Else
    MsgBox "Altersgruppe nicht definiert, Prozedur wird abgebrochen"
    Altersgruppe2Zahl = 99
End Select

End Function

Wäre sehr toll, wenn mir jemand helfen könnte! :-)

Viele Grüße und schon mal lieben Dank! Rada