AW: Schließen Quelldatei nach Load Befehl
22.08.2019 09:07:10
Torsten
So hier mal der veraenderte Code mit ausgeschalteter Fehlerbehandlung. Teste bitte und lass mich wissen, ob Fehlermeldung kommt. Wenn ja welche und welche Zeile beim Debuggen markiert ist. Ich kann es leider nicht ausprobieren. Dazu muesste ich deine Dateien nachbauen, aber dazu hab ich keine Lust und Zeit.
Sub Load()
'Auto-Aktualisierung und Screenupdates auschalten
Application.AutoRecover.Enabled = False
Application.ScreenUpdating = False
'Passwortabfrage zur Bedienung des Buttons
Dim strKey As String
strKey = InputBox(prompt:="Bitte geben Sie das Passwort ein:", Title:="Passworteingabe")
If strKey "Laborlogistik" Then
MsgBox prompt:="Das Passwort ist nicht korrekt.", Buttons:=vbOKOnly, Title:="Fehler"
Exit Sub
End If
Dim WBZiel As Workbook, ExportDatei As Variant
Dim WBQuelle As Workbook, WSZiel As Worksheet
Dim lZeile As Long
'Fehlerbehandlung auskommentiert, um zu sehen, wo Fehler auftritt
'On Error GoTo Fehler
Set WBZiel = ThisWorkbook
'Blattschutz von Ergebnisdatei aufheben
Dim shKey As String 'Password für Blattschutz (alle Blätter gleich!!)
shKey = "Laborlogistik"
'alle Sheets durchgehen und Blattschutz aufheben
Dim wsCounter As Worksheet
For Each wsCounter In WBZiel.Worksheets
wsCounter.Unprotect shKey
Next
'Spalten in Ergebnisdatei(Stammdaten) leeren
Sheet5.Range("A2:AD1000").Clear
'DateiÖffnen Dialog anbieten
ExportDatei = Application.GetOpenFilename()
'öffnen der ausgewählten Datei
Set WBQuelle = Workbooks.Open(ExportDatei)
'Blattschutz aller Tabellenblätter der Quelldatei aufheben
'eigentlich nicht noetig, da von hier nur kopiert wird
For Each wsCounter In WBQuelle.Worksheets
wsCounter.Unprotect shKey
Next
'kopieren des Blattinhaltes und Schließen der Quell-Datei
With WBQuelle
.Sheets("Chemikalien").Range("A5:ad5000").Copy
WBZiel.Sheets("Stammdaten").Range("A" & WBZiel.Sheets("Stammdaten").Cells(Rows.Count, 1) _
.End(xlUp).Row + 1).PasteSpecial xlPasteValues
.Sheets("Labormaterialien").Range("A5:ad1000").Copy
WBZiel.Sheets("Stammdaten").Range("A" & WBZiel.Sheets("Stammdaten").Cells(Rows.Count, 1) _
.End(xlUp).Row + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
'Schließen der ausgewählten Datei
Workbooks(WBQuelle).Close savechanges:=False
'Blattschutz für Ergebnisdatei wiederherstellen
For Each wsCounter In WBZiel.Worksheets
wsCounter.Protect shKey, True, True, True
Next
'Nach Ausführung wieder in das erste Tabellenblatt springen
WBZiel.Sheet1.Activate
Application.ScreenUpdating = True
Application.AutoRecover.Enabled = True
'Fehler:
'Exit Sub
End Sub
Gruss Torsten