Hallo liebe Leute,

ich will ein kleines Sortiermakro schreiben welches mir Daten die eine bestimmte Reihenfolge haben neben die Tabelle kopiert und dann weiter scannt bis die Tabelle endet. Ich habe zwei Spalten die ich für die "Überprüfung" der richtigen Reihenfolge nutze. Die Erst ist Slice und die zweite SporeID. Ich möchte quasi wenn Slice einmal von 1-46 hintereinander in der Tabelle auftaucht und dabei immer die gleiche SporeID hat einen Datenblock kopieren. Um das ganze dann zu beenden hatte ich vor, ans Ende der Tabelle das Wort "Ende" zu schreiben und wenn dieses Wort gescannt wird, soll das Makro enden (da ich nicht weiß wie ich das sonst abbrechen soll, da die Tabellen in der Länge variabel sind und teilweise Lücken haben). Das ganze hat auch schon mal einigermaßen funktioniert, dann hab ich aber einmal irgendwo was geändert und seitdem mag er die Zeilen "Do While Cells(Reihe_lesen, Spalte_SporeID).Value Ende" und "If ActiveWorkbook.ActiveSheet.Cells(Reihe_lesen, Spalte_Slice).Value = 1" nicht mehr er sagt mir immer Fehler 1004 Anwendungs - oder objektdefinierter Fehler. Ich hab alles mögliche versucht und auch schon das Internet durchforstet aber ich habe einfach keine Lösung gefunden. Ich habe selber nicht wirklich Ahnung von der Sprache VBA und habe mir das was ich gerade brauchte Zusammengelesen also habt Nachsicht ;) LG

Sub SporeGrabber()
Dim Slice As Integer
Dim SporeID As Integer
Dim Reihe_lesen As Integer
Dim Spalte_Slice As Integer
Dim Reihe_Speicher As Integer
Dim Slice_max As Integer
Dim Folge_Slice As Integer
Dim Ende As String
Dim Zeile As Integer
Dim SpalteAnfang As Integer
Dim i As Integer

Slice = 1
SporeID = 0
Reihe_lesen = 0
Spalte_Slice = 8
Spalte_SporeID = 12
Slice_max = 46
Ende = "Ende"
Reihe_Speicher = 0
Zeile = 1
SpalteAnfang = 14
i = 1

Do While Cells(Reihe_lesen, Spalte_SporeID).Value Ende
If ActiveWorkbook.ActiveSheet.Cells(Reihe_lesen, Spalte_Slice).Value = 1 Then
SporeID = Cells(Reihe_lesen, Spalte_SporeID).Value
Reihe_Speicher = Reihe_lesen
Slice = 1
Else
Reihe_lesen = Reihe_lesen + 1

End If

Do While ActiveWorkbook.ActiveSheet.Cells(Reihe_lesen + 1, Spalte_Slice).Value = Slice + 1 And ActiveWorkbook.ActiveSheet.Cells(Reihe_lesen + 1, Spalte_SporeID) = SporeID
If Slice = (Slice_max - 1) Then
'Kopier Befehl
For i = 1 To Slice_max
Cells(Zeile, SpalteAnfang) = Cells(Reihe_Speicher, 1)
Cells(Zeile, SpalteAnfang + 1) = Cells(Reihe_Speicher, 2)
Cells(Zeile, SpalteAnfang + 2) = Cells(Reihe_Speicher, 3)
Cells(Zeile, SpalteAnfang + 3) = Cells(Reihe_Speicher, 12)
Reihe_Speicher = Reihe_Speicher + 1
Zeile = Zeile + 1
Next i

If i = Slice_max - 1 Then
SpalteAnfang = SpalteAnfang + 6
Zeile = 1
End If

Else
Reihe_lesen = Reihe_lesen + 1
Slice = Slice + 1
End If

Loop

Loop

End Sub