Hilfe bei Laufzeitfehler 1004 bei for-Schleife

Hallo zusammen,
erstmal ein großes Lob an dieses Forum. Ich bin Anfänger mit VBA und habe schon einige Tipps hier entnehmen können. Nun stehe ich selber auf dem Schlauch.
In der angehängten Excel-Datei (https://www.herber.de/bbs/user/94452.xls)
habe ich im ersten Tabellenblatt 2 Spalten (nämlich die 2. und die 4.), die jeweils Messdaten in einer Spalte stehen haben. Spalte 1 und 3 sind x-Koordinaten der Messspur. Ich möchte, dass pro x-Koordinate die Daten in eine neue Spalte auf dem zweiten Tabellenblatt kommen.
Also alle Daten der zweiten Spalte, die sich auf die x-Koordinate 5890 in der ersten Spalte beziehen in die erste Spalte des zweiten Tabellenblattes, alle Daten der zweiten Spalte, die sich auf 55890 in der ersten Spalte beziehen, in die zweite Spalte usw... Insgesamt bekomme ich dann auf dem zweiten Tabellenblatt 9 neue Spalten.
Dies soll dann für die 4. Spalte wiederholt werden, die sich auf die 3. Spalte bezieht. Da habe ich dann die Variable "sprung" eingeführt, damit in der 10. Spalte auf dem zweiten Tabellenblatt die Tabelle angehängt wird. Da dies noch mehr Dateien werden, habe ich eine Schleife geschrieben, mit "m" als Laufvariable. Da setzt das Programm aber aus (Laufzeitfehler 1004), ich kann mir nicht erklären, warum. Wenn ich m=1 oder m=3 ohne Schleife mache, funktionierts. Mit Schleife nicht...
Bin für Hilfe mehr als dankbar ! Besten Gruß !
Angehängt der Code:

Sub Gesamtmakro()
Dim cDir As String
Dim sPath As String
Dim i As Integer
Dim n As String
Dim m As Integer
Dim zaehler1 As Integer
m = 1
i = 1
sprung = 0
zaehler1 = 1
zaehler2 = 0
zaehler3 = 0
zaehler4 = 0
zaehler5 = 0
zaehler6 = 0
zaehler7 = 0
zaehler8 = 0
sprung = 0
For m = 1 To 3 Step 2
For i = 1 To 13500
'1. Mess-Spur
If ThisWorkbook.Worksheets(1).Cells(i, m) = 5890 Then
ThisWorkbook.Worksheets(2).Cells(i, m + sprung) = ThisWorkbook.Worksheets(1).Cells(i, m + 1)
zaehler1 = zaehler1 + 1
End If
'2. Mess-Spur
If ThisWorkbook.Worksheets(1).Cells(i, m) = 55890 Then
ThisWorkbook.Worksheets(2).Cells(i + 1 - zaehler1, m + 1 + sprung) = ThisWorkbook.Worksheets(1). _
Cells(i, m + 1)
zaehler2 = zaehler2 + 1
End If
'3. Mess-Spur
If ThisWorkbook.Worksheets(1).Cells(i, m) = 105890 Then
ThisWorkbook.Worksheets(2).Cells(i + 1 - zaehler1 - zaehler2, m + 2 + sprung) = ThisWorkbook. _
Worksheets(1).Cells(i, m + 1)
zaehler3 = zaehler3 + 1
End If
''4. Mess-Spur
If ThisWorkbook.Worksheets(1).Cells(i, m) = 155890 Then
ThisWorkbook.Worksheets(2).Cells(i + 1 - zaehler1 - zaehler2 - zaehler3, m + 3 + sprung) =  _
ThisWorkbook.Worksheets(1).Cells(i, m + 1)
zaehler4 = zaehler4 + 1
End If
''5. Mess-Spur
If ThisWorkbook.Worksheets(1).Cells(i, m) = 205890 Then
ThisWorkbook.Worksheets(2).Cells(i + 1 - zaehler1 - zaehler2 - zaehler3 - zaehler4, m + 4 +  _
sprung) = ThisWorkbook.Worksheets(1).Cells(i, m + 1)
zaehler5 = zaehler5 + 1
End If
''6. Mess-Spur
If ThisWorkbook.Worksheets(1).Cells(i, m) = 255890 Then
ThisWorkbook.Worksheets(2).Cells(i + 1 - zaehler1 - zaehler2 - zaehler3 - zaehler4 - zaehler5,  _
m + 5 + sprung) = ThisWorkbook.Worksheets(1).Cells(i, m + 1)
zaehler6 = zaehler6 + 1
End If
''7. Mess-Spur
If ThisWorkbook.Worksheets(1).Cells(i, m) = 305890 Then
ThisWorkbook.Worksheets(2).Cells(i + 1 - zaehler1 - zaehler2 - zaehler3 - zaehler4 - zaehler5 -  _
zaehler6, m + 6 + sprung) = ThisWorkbook.Worksheets(1).Cells(i, m + 1)
zaehler7 = zaehler7 + 1
End If
''8. Mess-Spur
If ThisWorkbook.Worksheets(1).Cells(i, m) = 355890 Then
ThisWorkbook.Worksheets(2).Cells(i + 1 - zaehler1 - zaehler2 - zaehler3 - zaehler4 - zaehler5 -  _
zaehler6 - zaehler7, m + 7 + sprung) = ThisWorkbook.Worksheets(1).Cells(i, m + 1)
zaehler8 = zaehler8 + 1
End If
''9. Mess-Spur
If ThisWorkbook.Worksheets(1).Cells(i, m) = 405890 Then
ThisWorkbook.Worksheets(2).Cells(i + 1 - zaehler1 - zaehler2 - zaehler3 - zaehler4 - zaehler5 -  _
zaehler6 - zaehler7 - zaehler8, m + 8 + sprung) = ThisWorkbook.Worksheets(1).Cells(i, m + 1)
End If
'n = n + 1
Next i
sprung = sprung + 7
Next m
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Gesamtmakro_alt() Dim cDir As String Dim sPath As String Dim i As Integer Dim n As String Dim m As Integer Dim zaehler1 As Integer m = 1 i = 1 sprung = 0 For m = 1 To 3 Step 2 zaehler1 = 1 zaehler2 = 0 zaehler3 = 0 zaehler4 = 0 zaehler5 = 0 zaehler6 = 0 zaehler7 = 0 zaehler8 = 0 For i = 1 To 13500

Sub Gesamtmakro() Dim cDir As String Dim sPath As String Dim m As Integer Dim wksData As Worksheet Dim wksZiel As Worksheet Dim Zeile As Long, Spalte As Long Dim iSpur As Integer, Messung As Integer Dim arrMessSpur(1 To 9) Dim arrZeile_Z(1 To 9) As Long arrMessSpur(1) = 5890 arrMessSpur(2) = 55890 arrMessSpur(3) = 105890 arrMessSpur(4) = 155890 arrMessSpur(5) = 205890 arrMessSpur(6) = 255890 arrMessSpur(7) = 305890 arrMessSpur(8) = 355890 arrMessSpur(9) = 405890 Set wksData = ActiveWorkbook.Worksheets(1) If ActiveWorkbook.Worksheets.Count = 1 Then ActiveWorkbook.Worksheets.Add after:=wksData Set wksZiel = ActiveSheet Else Set wksZiel = ActiveWorkbook.Worksheets(2) End If sprung = 9 'Anzahl Spalten zwischen den Spalten der 1. Messspur der Messungen 'Makrobremsen lösen With Application .ScreenUpdating = False .EnableEvents = False StatusCalc = .Calculation .Calculation = xlCalculationManual End With With wksData For m = 1 To 3 Step 2 'Zähler für Spalten der Messungen Messung = Messung + 1 '1. Spalte einer Messung mit den Daten der 1. Messspur Spalte1 = 1 + (Messung - 1) * sprung 'Startwerte für Zeilenzähler der Messspur im Zielblatt setzen und SpaltenTitel _ eintragen With wksZiel .Cells(1, Spalte1).Value = "Messung " & Messung For iSpur = LBound(arrMessSpur) To UBound(arrMessSpur) 'Spaltentitel eintragen arrZeile_Z(iSpur) = 2 .Cells(arrZeile_Z(iSpur), Spalte1 + (iSpur - 1)) = arrMessSpur(iSpur) 'letzte ausgefüllte Zeile in Spalten arrZeile_Z(iSpur) = .Cells(.Rows.Count, Spalte1 + (iSpur - 1)).End(xlUp). _ Row Next iSpur End With 'Zeilen der Messung abarbeiten For Zeile = 1 To .Cells(.Rows.Count, m).End(xlUp).Row 'Messspur und Messwert einlesen With .Cells(Zeile, m) Messspur = .Value Messwert = .Offset(0, 1).Value End With 'Messspuren vergleichen und Messwert in Zielspalte eintragen For iSpur = LBound(arrMessSpur) To UBound(arrMessSpur) If arrMessSpur(iSpur) = Messspur Then arrZeile_Z(iSpur) = arrZeile_Z(iSpur) + 1 wksZiel.Cells(arrZeile_Z(iSpur), Spalte1 + (iSpur - 1)) = Messwert Exit For End If Next iSpur Next Zeile Next m End With 'wksData 'Makrobremsen zurücksetzen With Application .ScreenUpdating = True .EnableEvents = True .Calculation = StatusCalc End With End Sub

Sub Messspuren_Umordnen() shQuelle = "Rohdaten" shZiel = "Umsetzen" sprung = 0 ls = Cells(2, Columns.Count).End(xlToLeft).Column For m = 1 To ls Step 2 lz = Sheets(shQuelle).Cells(65536, m).End(xlUp).Row For zeile = 2 To lz 'Spalte für x-Koordinaten (9) Select Case Sheets(shQuelle).Cells(zeile, m) Case 5890 spalte = 1 + sprung Case 55890 spalte = 2 + sprung Case 105890 spalte = 3 + sprung Case 155890 spalte = 4 + sprung Case 205890 spalte = 5 + sprung Case 255890 spalte = 6 + sprung Case 305890 spalte = 7 + sprung Case 355890 spalte = 8 + sprung Case 405890 spalte = 9 + sprung End Select 'messwert aus spalte2 ins Zielsheet schreiben n = Sheets(shZiel).Cells(65536, spalte).End(xlUp).Row + 1 Sheets(shZiel).Cells(n, spalte) = Sheets(shQuelle).Cells(zeile, m + 1) Next sprung = sprung + 9 Next End Sub

Beliebteste Forumthreads (12 Monate)

Hilfe bei Laufzeitfehler 1004 bei for-Schleife

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Hilfe bei Laufzeitfehler 1004 bei for-Schleife

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread