Laufzeitfehler 52 an Luschi
16.06.2020 07:15:14
Uli
Luschi hat mir die Datei angepasst . Zu diesem Zeitpunkt lagen die Dateien alle in einem Ordner. Nun habe ich die Dateien in die Endgültigen Ordner gelegt.
Soweit so gut. Bin leider kein VBA Profi.
Bekomme immer den Laufzeitfehler 52 und das Makro bleibt hier hängen If Dir(sPfad & sDatei, vbNormal) "" Then
Zur Erklärung:
In der Datei : T:\Montage\Schichtübergabeprotokoll\Schichtübergabe_MO.xlsm werden werte eingetragen die dann per Makro in die Datei :T:\Prüflehren\PT05_FB_0001_Aktions- und Maßnahmenplan_MB.xlsm
übergeben werden.
Glaube habe beim angeben der Pfade etwas vergessen oder etwas falsch eingetragen.
Wo ist der Fehler ? Finde ihn nicht.
Danke und Gruß Uli
Public Sub Schreiben_PMV_Früh()
Application.ScreenUpdating = False
'schreibt in geschlossene PMV
Dim sPfad As String ' der Ordner-Pfad der Excel-Mappen
Dim sDatei As String ' die zu beschreibende Datei
Dim WkSh_Q As Worksheet ' das Quell-Tabellenblatt - die Herkunft
Dim WkSh_Z As Worksheet ' das Ziel-Tabellenblatt - das Ergebnis
Dim ersteFreieZelle As Long
'Pfad Luschi
sPfad = ThisWorkbook.Path & ""
sDatei = "\T:\Prüflehren\PT05_FB_0001_Aktions- und Maßnahmenplan_MB.xlsm\"
If Dir(sPfad & sDatei, vbNormal) "" Then
Workbooks.Open (sPfad & sDatei)
ThisWorkbook.Activate
Else
MsgBox "Den angegebenen Ordner """ & sPfad & """" & Chr(10) & _
"und/oder die gesuchte Datei """ & sDatei & """ gibt es nicht!", _
16, " Hinweis für " & Application.UserName
Exit Sub
End If
Set WkSh_Q = ThisWorkbook.Worksheets("Frühschicht")
'neu
Application.EnableEvents = False
Set WkSh_Z = Workbooks(sDatei).Worksheets(WkSh_Q.Range("A74").Value)
ersteFreieZelle = WorksheetFunction.Max(7 - 1, WkSh_Z.Range("B29").End(xlUp).Row) + 1
WkSh_Z.Unprotect ""
WkSh_Q.Cells.Range("C74:E74").Copy Destination:=WkSh_Z.Range("B" & ersteFreieZelle & ":D" & _
ersteFreieZelle)
Application.EnableEvents = True
'datum in action plan schreiben
WkSh_Z.Range("B" & ersteFreieZelle) = Date
WkSh_Z.Protect ""
MsgBox "Die Daten wurden erfolgreich übergeben.", _
64, " Information für " & Application.UserName
With WkSh_Z.Parent
.Save
.Saved = True
'.Close False
End With
Set WkSh_Q = Nothing: Set WkSh_Z = Nothing
Application.ScreenUpdating = True
End Sub