Laufzeitfehler 1004
08.12.2018 15:49:30
Dietmar
ich habe eine Arbeitsmappe mit 2 Tabellenblätter mit den Spalten A-G. Das dazugehörige Makro funktioniert einwandfrei.
Dim i, a, b, c, Lfdnr
Sub Zeile()
' Makro1 Makro
' Makro am 12.11.03 von St0191 aufgezeichnet
Application.ScreenUpdating = False
Lfd_Nr
Hoechstwert
End Sub
Sub Archiv()
Application.ScreenUpdating = False
Lfd_Nr
Sheets("erledigte F?lle").Select
Range("A5").Select
i = 1
a = 1
b = 1
c = 1
Do While i ""
ActiveCell.Offset(1, 0).Select
i = ActiveCell.Value
a = a + 1
Loop
Do While i ""
ActiveCell.Offset(1, 0).Select
i = ActiveCell.Value
a = a + 1
Loop
Range("F" & a + 5).Select
ActiveCell.Value = 999999999
Range("A" & a + 4).Select
Sheets("offene F?lle").Select
Range("A5").Select
i = ActiveCell.Value
Do While i ""
ActiveCell.Offset(1, 0).Select
i = ActiveCell.Value
b = b + 1
Loop
Range("F" & b + 5).Select
ActiveCell.Value = 999999999
Range("F5").Select
Do While i 999999999
i = ActiveCell.Value
c = c + 1
If i = 1 Then
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Cut
Sheets("erledigte F?lle").Select
ActiveCell.Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Range("A1").Select
Sheets("offene F?lle").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(0, 5).Select
End If
If ActiveCell.Value = 1 Then
GoTo weiter
ActiveCell.Offset(-1, 0).Select
End If
ActiveCell.Offset(1, 0).Select
weiter:
Loop
Sheets("offene F?lle").Select
Range("A5").Select
Range("F" & b + 4).Select
ActiveCell.Delete
Hoechstwert
ActiveCell.Offset(1, 4).Select
Selection.ClearContents
ActiveCell.Offset(-1, -4).Select
Application.ScreenUpdating = True
End Sub
Sub Lfd_Nr()
Range("A6").Select
i = 1
a = 1
Do While i ""
ActiveCell.Offset(1, 0).Select
i = ActiveCell.Value
a = a + 1
Loop
ActiveCell.Offset(-1, 0).Select
Lfdnr = ActiveCell.Value
End Sub
Sub Hoechstwert()
Range("A6").Select
i = 1
a = 1
Do While i ""
ActiveCell.Offset(1, 0).Select
i = ActiveCell.Value
a = a + 1
Loop
ActiveCell.Offset(-1, 0).Range("A1").Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.ClearContents
ActiveCell.Select
ActiveCell.Value = Lfdnr + 1
' ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
' Selection.Copy
' ActiveCell.Offset(1, 0).Select
' Selection.PasteSpecial Paste:=xlFormats
'Application.CutCopyMode = False
'ActiveCell.Offset(0, 1).Select
' ActiveCell.Range("A1:F1").Select
' Selection.Locked = False
' Selection.FormulaHidden = False
ActiveCell.Select
End Sub
Ich muss nun die Spalten bis M erweitern. Die Spalte F in der ersten Version ist nunmehr bei der Erweiterung die Spalte M. Was muss ich ändern, damit das Makro funktioniert? Bisher habe ich die Werte, wo die Spalte F vorkommt, auf M geändert. Leider gibt es einen Laufzeitfehler und hängt an dieser Stelle:
SUB Archiv..........
End If
ActiveCell.Offset(1, 0).Select
Was muss ich ändern?
Für eine Hilfe wäre ich sehr dankbar.