Eventualitäten berücksichtigen

Sub Aktualisieren() Application.ScreenUpdating = False Application.DisplayAlerts = False Sheets("Druckbehälter").Delete Application.DisplayAlerts = True Dim QWB As Workbook, ZWB As Workbook Workbooks.Open "C:\...\Quelldatei.xlsm", ReadOnly:=True, Password:="123", WriteResPassword:= _ "123" Set QWB = Workbooks("Quelldatei.xlsm") Set ZWB = ThisWorkbook Set QWS = QWB.Worksheets("Druckbehälter") Set ZWS = ZWB.Worksheets("Tabelle1") QWS.Copy after:=ZWS Workbooks("Druckbehälter.xlsm").Close savechanges:=False Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Vilen,
mit Prüfungen/Fehlerbehandlung kann es etw wie folgt aussehen.
Einige Prüfunngen könnte man noch in der Reihenfolge ändern und auch bei der Schahtelung der If-Prüfungen sind noch anders schachtelbar. Das hängt dann davon ab, wie du die jeweiligen Ergebnisse weiterverarbeiten möchtest.
Gruß
Franz

Sub Aktualisieren()
Dim QWB As Workbook, ZWB As Workbook
Dim QWS As Worksheet, ZWS As Worksheet
Dim strQuelle As String
On Error GoTo Fehler
Application.ScreenUpdating = False
Set ZWB = ThisWorkbook
strQuelle = "C:\...\Quelldatei.xlsm"
If Dir(strQuelle)  "" Then
Set QWB = Workbooks.Open(strQuelle, ReadOnly:=True, Password:="123", _
WriteResPassword:="123")
If fncCheckSheet("Tabelle1", ZWB) Then
Set ZWS = ZWB.Worksheets("Tabelle1")
Else
Set ZWS = ZWB.Worksheets(1)
End If
If fncCheckSheet("Druckbehälter", QWB) Then
If fncCheckSheet("Druckbehälter", ZWB) Then
Application.DisplayAlerts = False
ZWB.Sheets("Druckbehälter").Delete
Application.DisplayAlerts = True
End If
Set QWS = QWB.Worksheets("Druckbehälter")
QWS.Copy after:=ZWS
QWB.Close savechanges:=False
Else
MsgBox "Blatt ""Druckbehälter"" in Datei " & vbLf & _
QWB.FullName & vbLf & _
"nicht gefunden", vbOKOnly, "Fehler - Makro: Aktualisieren"
End If
Else
MsgBox "Datei" & vbLf & strQuelle & vbLf & _
"Nicht gefunden/konnte nicht geöffnet werden", _
vbOKOnly, "Fehler - Makro: Aktualisieren"
End If
Fehler:
With Err
Select Case .Number
Case 0 'Alles ist ok
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbInformation + vbOKOnly, "Fehler - Makro: Aktualisieren"
End Select
End With
Application.ScreenUpdating = True
End Sub
Public Function fncCheckSheet(strSheetName As String, Optional wkb As Workbook) As Boolean
'Prüft, on Blatt in Arbeitsmape vorhanden
' True = vorhanden  -  False = nicht vorhanden
Dim objSheet As Object
On Error GoTo Fehler
Set objSheet = wkb.Sheets(strSheetName)
fncCheckSheet = True
Exit Function
Fehler:
End Function

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread