Quelle bei Errorr ändern
02.01.2023 13:18:28
mathias_l
ich hatte mein Progamm am laufen und es ging auch sehr gut bis jetzt die ersten Monate aus unsrem Dienstplan in eine Backup Datei transferiert wurden. Jetzt hätte ich gerne, dass wenn die Tabellenblätter des Array nicht gefunden werden nicht Fehler 9 kommt, sondern das dann die Datei des Backup vom Dienstplan genommen wird.
Man kann in meiner Tabelle das Jahr wählen und die Backup Datei liegt auch in einem Ordener mit dem Jahr und endet auch mit der Jahreszahl.
Vielleicht kann man das ja nicht mit einem festen Jahr schreiben sondern so, dass immer erst nach einem Ordner und einer Datei darin geschaut wird und wenn es keinen Ordner bzw Datei gibt (also kein Backup vorhanden ist) dann nimmt er den normalen Dienstplan.
https://www.herber.de/bbs/user/157036.zip
geht leider nur als zip.
Sub Okay()
Stamm = Application.ActiveWorkbook.Name
Quelldatei = "Dienstplan.xlsm" 'Dateiname anpassen
Sheets("Dienstantritte").Unprotect "test"
Sheets("Dienstantritte").Cells.Range("A11:BA5000").Clear
strSuchwort = UserForm1.ComboBox1.Value
Workbooks.Open Filename:="I:\218407\31-5620-E-WacheDPLEssMeld\01 Dienstplan\011 Jahresdienstplan\" & Quelldatei 'Ablageort der Quelldatei anpassen
Assets = Array("Januar " & Workbooks(Stamm).Sheets("Dienstantritte").Cells(7, 33), _
"Februar " & Workbooks(Stamm).Worksheets("Dienstantritte").Cells(7, 33), _
"März " & Workbooks(Stamm).Worksheets("Dienstantritte").Cells(7, 33), _
"April " & Workbooks(Stamm).Worksheets("Dienstantritte").Cells(7, 33), _
"Mai " & Workbooks(Stamm).Worksheets("Dienstantritte").Cells(7, 33), _
"Juni " & Workbooks(Stamm).Worksheets("Dienstantritte").Cells(7, 33), _
"Juli " & Workbooks(Stamm).Worksheets("Dienstantritte").Cells(7, 33), _
"August " & Workbooks(Stamm).Worksheets("Dienstantritte").Cells(7, 33), _
"September " & Workbooks(Stamm).Worksheets("Dienstantritte").Cells(7, 33), _
"Oktober " & Workbooks(Stamm).Worksheets("Dienstantritte").Cells(7, 33), _
"November " & Workbooks(Stamm).Worksheets("Dienstantritte").Cells(7, 33), _
"Dezember " & Workbooks(Stamm).Worksheets("Dienstantritte").Cells(7, 33))
'On Error GoTo ErrorHandler
For Each Asset In Assets
Workbooks(Quelldatei).Sheets(Asset).Range("A10:AJ11").Copy ' Blatt/Bereich anpassen
Workbooks(Stamm).Sheets("Dienstantritte").Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial xlPasteAll ' Blatt/Bereich anpassen
For Each rngZelle In Workbooks(Quelldatei).Sheets(Asset).Range("C:C")
If rngZelle = strSuchwort Then
rngZelle.EntireRow.Copy
Workbooks(Stamm).Sheets("Dienstantritte").Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial xlPasteAll
End If
Next
Next
Application.CutCopyMode = False
Workbooks(Quelldatei).Close
Set MyRange = Range("A11:AJ46")
For Each Cell In MyRange
If Cell.Interior.Pattern = xlPatternLightHorizontal Then
Cell.ClearContents
End If
If Cell.Interior.Pattern = xlPatternSemiGray75 Then
Cell.ClearContents
End If
Next Cell
Cells.Select
Range("A1").Activate
Selection.Locked = True
Range("A11:AJ46").Select
Selection.Locked = False
Range("AF8").Select
Selection.Locked = False
Worksheets("Dienstantritte").Protect "test"
Unload UserForm1
'ErrorHandler:
End Sub