Aufteilung von Daten --> Laufzeitfehler 6

Hallo liebe Community,
ich würde gerne durch ein Sub die verschiedenen Bezeichnungen der Spalte C in verschiedene Tabellenblätter unterteilen.
Hierzu benutze ich folgendes Sub:


Sub Aufteilen()
On Error GoTo Fehler
Dim Reihe, SP, RR, i%, TB1, TB2, UB
Set TB1 = ActiveSheet
UB = 0
With TB1
RR = .Cells.SpecialCells(xlCellTypeLastCell).Row
SP = 3
For i = RR To 1 + UB Step -1
If .Cells(i, SP)  "" And .Cells(i - 1, SP)  .Cells(i, SP) Then
Sheets.Add After:=Sheets(Sheets.Count)
Set TB2 = ActiveSheet
If UB = 1 Then .Rows("1:1").Copy TB2.Cells(1, 1)
.Rows(i & ":" & RR).Copy TB2.Cells(1 + UB, 1)
.Rows(i & ":" & RR).Delete xlUp
TB2.Name = TB2.Cells(1 + UB, SP)
RR = i
End If
Next
Application.DisplayAlerts = True
.Delete
End With
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
Application.DisplayAlerts = True
End Sub

Wenn ich das anwende, dann bekomme ich den "Laufzeitfehler 6: Überlauf" ich hab dazu jetzt schon einiges gelesen aber keine passende Lösung gefunden.
Ich hoffe jemand kann mir dabei helfen...
Liebe Grüße
Peter :)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Peter,
bis zu welcher Zeile funktioniert denn dein Makro? (mit F8 einfach durchklicken)
Ich kann deinen Fehler jedenfalls nicht reproduzieren, das Makro läuft bis soweit durch, bis auf das letzte Tabellenblatt. Dort kommt bei mir der F1004, aber das liegt daran, dass dort auf die Nullte Zeile zugeriffen wird, was ja Unsinn ist.
.Cells(i - 1, SP)
Überlauf kenn ich nur, wenn eine Variable außerhalb ihres Wertebereiches fällt. Da die einzige eingegrenzte Variable i ist und sie zwischen -32.768 bis 32.767 liegen muss, könnt ich mir nur vorstellen, dass du mehr als 32.767 Zeilen benutzt. An der Stelle
For i = RR würde i dann überlaufen. Checke also mal was bei deinem RR rauskommt.
lg Matthias

Sub Gruppe_neues_Blatt() On Error GoTo Fehler Dim SP As Single, RR As Double, i As Double, TB1, TB2, UB As Single Set TB1 = ActiveSheet UB = 0 '1 , wenn Überschrift With TB1 RR = .Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes SP = 3 'Trennen nach Spalte C For i = RR To 2 + UB Step -1 If .Cells(i, SP) "" And .Cells(i - 1, SP) .Cells(i, SP) Then Sheets.Add After:=Sheets(Sheets.Count) Set TB2 = ActiveSheet If UB = 1 Then .Rows("1:1").Copy TB2.Cells(1, 1) .Rows(i & ":" & RR).Copy TB2.Cells(1 + UB, 1) .Rows(i & ":" & RR).Delete xlUp TB2.Name = TB2.Cells(1 + UB, SP) RR = i - 1 End If Next .Name = .Cells(1 + UB, SP) End With Err.Clear Fehler: If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear End Sub

Beliebteste Forumthreads (12 Monate)

Aufteilung von Daten --> Laufzeitfehler 6

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread