Was ist an meinem Makro falsch?

Question

Hallo Supporter :-)

Ich habe da mal ein Makro gebastelt. Im Grunde fügt er verschiedene
Tabellen in eine zusammen. Dabei steht jede Ausgangstabelle auf
einem anderen Tabellenblatt. Die "neue" Tabelle wird dann auf
einem eigenen Tabellenblatt "zusammengeschrieben".

Nun das Problem:
Das Makro funktioniert solange, solange ich mich beim
AUSFÜHREN auf der Seite befinde, auf der die neue Tabelle
eingefügt wird! Führe ich das Makro auf einem beliebigen anderen
Tabellenblatt aus, dann funktioniert es nicht, OHNE das eine
Fehlermeldung kommt...

Ich bin im Debugger mal per Einzelschritt durchgegangen ohne
einen Fehler oder Hinweis zu finden.

Hier mal der Code für ein MINIMALBEISPIEL mit drei Tabellen:

Sub Mein_Code()

Dim s1 As Variant
Dim s3 As Variant
Dim s5 As Variant

Dim t1 As Long
Dim t2 As Long
Dim t3 As Long


t1 = Worksheets("tab1").Cells(7, 4).End(xlDown).Row
t2 = Worksheets("tab2").Cells(7, 4).End(xlDown).Row
t3 = Worksheets("tab3").Cells(7, 4).End(xlDown).Row


Worksheets("Daten").Range("A2:F10000").Clear


' tab1

For i = 8 To t1
s1 = Worksheets("tab1").Range("B" & i).Value
Worksheets("Daten").Cells(Application.Max(1, Cells(Rows.Count,
1).End(xlUp).Row + 1), 1) = s1

s3 = Worksheets("tab1").Range("D" & i).Value
Worksheets("Daten").Cells(Application.Max(1, Cells(Rows.Count,
3).End(xlUp).Row + 1), 3) = s3

s5 = Worksheets("tab1").Range("K" & i).Value
Worksheets("Daten").Cells(Application.Max(1, Cells(Rows.Count,
5).End(xlUp).Row + 1), 5) = s5
Next


'tab2

For i = 8 To t2
s1 = Worksheets("tab2").Range("B" & i).Value
Worksheets("Daten").Cells(Application.Max(1, Cells(Rows.Count,
1).End(xlUp).Row + 1), 1) = s1

s3 = Worksheets("tab2").Range("D" & i).Value
Worksheets("Daten").Cells(Application.Max(1, Cells(Rows.Count,
3).End(xlUp).Row + 1), 3) = s3

s5 = Worksheets("tab2").Range("K" & i).Value
Worksheets("Daten").Cells(Application.Max(1, Cells(Rows.Count,
5).End(xlUp).Row + 1), 5) = s5
Next


'tab3

For i = 8 To t3
s1 = Worksheets("tab3").Range("B" & i).Value
Worksheets("Daten").Cells(Application.Max(1, Cells(Rows.Count,
1).End(xlUp).Row + 1), 1) = s1

s3 = Worksheets("tab3").Range("D" & i).Value
Worksheets("Daten").Cells(Application.Max(1, Cells(Rows.Count,
3).End(xlUp).Row + 1), 3) = s3

s5 = Worksheets("tab3").Range("K" & i).Value
Worksheets("Daten").Cells(Application.Max(1, Cells(Rows.Count,
5).End(xlUp).Row + 1), 5) = s5
Next

End Sub

Könnt ihr mir bitte sagen wo das Problem liegt???
Ich versuche das jetzt schon seit mehreren Stunden (kein Spaß)
hinzubekommen ;...(

Wer sich die Datei mal ansehen will bzw. es selbst versuchen will,
hier:
localhostr.com/file/upRehbK/file.xlsm


Über Hilfe würde ich mich ungemein freuen.
Vielen Dank!

Lisa

Answer 1

Hallo Lisa,

Option Explicit

Sub Mein_Code()
Dim s1 As Variant
Dim s3 As Variant
Dim s5 As Variant
Dim t1 As Long
Dim t2 As Long
Dim t3 As Long
t1 = Worksheets("tab1").Cells(7, 4).End(xlDown).Row
t2 = Worksheets("tab2").Cells(7, 4).End(xlDown).Row
t3 = Worksheets("tab3").Cells(7, 4).End(xlDown).Row
With Worksheets("Daten")
.Range("A2:F10000").Clear
' tab1
For i = 8 To t1
s1 = Worksheets("tab1").Range("B" & i).Value
.Cells(Application.Max(1, .Cells(Rows.Count, 1).End(xlUp).Row + 1), 1) = s1
s3 = Worksheets("tab1").Range("D" & i).Value
.Cells(Application.Max(1, .Cells(Rows.Count, 3).End(xlUp).Row + 1), 3) = s3
s5 = Worksheets("tab1").Range("K" & i).Value
.Cells(Application.Max(1, .Cells(Rows.Count, 5).End(xlUp).Row + 1), 5) = s5
Next
'tab2
For i = 8 To t2
s1 = Worksheets("tab2").Range("B" & i).Value
.Cells(Application.Max(1, .Cells(Rows.Count, 1).End(xlUp).Row + 1), 1) = s1
s3 = Worksheets("tab2").Range("D" & i).Value
.Cells(Application.Max(1, .Cells(Rows.Count, 3).End(xlUp).Row + 1), 3) = s3
s5 = Worksheets("tab2").Range("K" & i).Value
.Cells(Application.Max(1, .Cells(Rows.Count, 5).End(xlUp).Row + 1), 5) = s5
Next
'tab3
For i = 8 To t3
s1 = Worksheets("tab3").Range("B" & i).Value
.Cells(Application.Max(1, .Cells(Rows.Count, 1).End(xlUp).Row + 1), 1) = s1
s3 = Worksheets("tab3").Range("D" & i).Value
.Cells(Application.Max(1, .Cells(Rows.Count, 3).End(xlUp).Row + 1), 3) = s3
s5 = Worksheets("tab3").Range("K" & i).Value
.Cells(Application.Max(1, .Cells(Rows.Count, 5).End(xlUp).Row + 1), 5) = s5
Next
End With
End Sub

Gruß hajo

Answer 2

Hallo Lisa,

un ein wenig aufgeräumt.

Option Explicit

Sub Mein_Code()
Dim Loi As Long
Dim I As Long
With Worksheets("Daten")
.Range("A2:F10000").Clear
' tab1
For Loi = 1 To 3
For I = 8 To Worksheets("tab" & Loi).Cells(7, 4).End(xlDown).Row
.Cells(Application.Max(1, .Cells(Rows.Count, 1).End(xlUp).Row + 1), 1) = _
Worksheets("tab" & Loi).Range("B" & I).Value
.Cells(Application.Max(1, .Cells(Rows.Count, 3).End(xlUp).Row + 1), 3) = _
Worksheets("tab" & Loi).Range("D" & I).Value
.Cells(Application.Max(1, .Cells(Rows.Count, 5).End(xlUp).Row + 1), 5) = _
Worksheets("tab" & Loi).Range("K" & I).Value
Next
Next Loi
End With
End Sub

Gruß Hajo

Answer 3

Unglaublich...
Schon ne Antwort???

Und es funktioniert auch noch :-)

ICH DANKE DIR!!
Noch einen schönen Abend!