Lesefehler 9

Guten morgen und Danke für die Antwort. Kann es sein das es auch durch diese Zeile hervorgerufen wird:


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


weil Private Sub Workbook_Open() hab ich so jetzt nicht gesehen, aber die Zeile die ich oben eingefügt hab stand bei ThisWorkbook30 gleich ganz oben.

Was kann ich machen um den Laufzeitfehler wegzubekommen?

MfG

Hier ist der Quellcode von dem Sub:


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim SheetNow, ErsteLeereSp As Double, ErsteLeereZ As Double, LetzteLeereSp As Double, LetzteLeereZ As Double
Dim ZeileNow As Double, SpalteNow As Double, x As Double
Set ShKapa = ThisWorkbook.Worksheets("Kapa")
Set ShPPS = ThisWorkbook.Worksheets("PPS")
Set ShPara = ThisWorkbook.Worksheets("Parameter")
' Datenbereich wieder korrekt setzen
Application.ScreenUpdating = False
Application.EnableEvents = False
SpaltenBestimmen
SheetNow = ActiveSheet.Name
ZeileNow = ActiveCell.Row
SpalteNow = ActiveCell.Column
ShKapa.Select
arrTemp = ShKapa.Range("Datenbereich").CurrentRegion
ErsteLeereZ = UBound(arrTemp, 1) + ShKapa.Range("Datenbereich").Row
LetzteLeereZ = ShKapa.Cells.SpecialCells(xlLastCell).Row
ErsteLeereSp = UBound(arrTemp, 2) + 1
LetzteLeereSp = ShKapa.Cells.SpecialCells(xlLastCell).Column
If LetzteLeereZ > ErsteLeereZ Then ShKapa.Range(Rows(ErsteLeereZ), Rows(LetzteLeereZ)).Delete
If LetzteLeereSp > ErsteLeereSp Then ShKapa.Range(Columns(ErsteLeereSp), Columns(LetzteLeereSp)).Delete
Sheets(SheetNow).Activate
Sheets(SheetNow).Cells(ZeileNow, SpalteNow).Activate
Application.ScreenUpdating = True
Application.EnableEvents = True
For x = 2 To UBound(arrTemp, 1)
If arrTemp(x, Kunde) = "Kapa" Then
ActiveWorkbook.Names.Add Name:="OrgStart", RefersTo:="=KAPA!$A$" & _
x + ShKapa.Range("Datenbereich").Row - 1
Exit For
End If
Next x
arrTemp = ShPara.Range("LogListe").CurrentRegion
For x = 35 To 3 Step -1
arrTemp(x, 1) = arrTemp(x - 1, 1)
arrTemp(x, 2) = arrTemp(x - 1, 2)
Next x
arrTemp(2, 1) = UCase(getUserInitials)
arrTemp(2, 2) = Now()
ShPara.Range("LogListe").CurrentRegion = arrTemp

'Erweiterung Sicherungskonzept

Dim fs, afs, file, FDatum As String, Pfad As String, i As Integer
Pfad = ThisWorkbook.Path
ChDir Pfad
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists("Sicherungskopie von " & Replace(ThisWorkbook.Name, ".xls", "") & ".xlk") Then
Set file = fs.GetFile("Sicherungskopie von " & Replace(ThisWorkbook.Name, ".xls", "") & ".xlk")
FDatum = Format(file.DateLastModified, "YYYY_MM_DD_HH_MM_SS")
Name ("Sicherungskopie von " & Replace(ThisWorkbook.Name, ".xls", "") & ".xlk") As FDatum & "_" & UCase(getUserInitials) & "_" & ("Sicherungskopie von " & Replace(ThisWorkbook.Name, ".xls", "") & ".xlk")
End If

Set afs = Application.FileSearch
With afs
.LookIn = Pfad
.Filename = "*.xlk"
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count - 13
file = fs.GetFileName(.FoundFiles(i))
' If Val(Left(file, 4)) < Year(Now()) _
' Or Val(Mid(file, 6, 2)) < Month(Now()) _
' Or Val(Mid(file, 9, 2)) < Day(Now()) Then
Kill file
' End If
Next i
End If
End With
End Sub


MfG

Also ich hab gerade mal nachgeschaut die Tabellen gibt es und wenn ich nach dem speichern auf debuggen klicke bleibt der Debugger an folgender Stelle stehen (Fett):

arrTemp = ShPara.Range("LogListe").CurrentRegion
For x = 35 To 3 Step -1

arrTemp(x, 1) = arrTemp(x - 1, 1)

arrTemp(x, 2) = arrTemp(x - 1, 2)
Next x
arrTemp(2, 1) = UCase(getUserInitials)
arrTemp(2, 2) = Now()
ShPara.Range("LogListe").CurrentRegion = arrTemp

MfG

LogListe bezieht sich bei mir auf eine Zelle in der einfach nur KZ steht. Kann es daran liegen das das nicht geht?

MfG und Danke noch mal

Danke für die Hilfe ich werd mal sehen ob es mir weiter hilft aber jetzt hab ich wenigstens einen Ansatz.

MfG