Grüezi allerseits. Ich habe ein Makro mit welchem Auswahldaten in eine geschlossene Datei einkopiert werden. Das Makro funktioniert einwandfrei, wenn die geschlossene Datei nicht schreibgeschützt ist. Mein Problem besteht darin, dass ich zu wenig VBA-Kenntnisse habe an welcher Stelle im Makro der Schreibschutz aufgehoben, bzw. nach dem Kopiervorgang wieder aktiviert wird. Vielleicht ist es möglich, dass jemand die erforderlichen Befehle gleich am richtigen Ort in mein beigefügtes Makro einfügen kann. Danke für die Hilfeleistung und allen ein schöner Tag, Kettenriss
_______________________________________
Sub Akku_kopieren() ' Daten in geschlossene Datei kopieren

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

sPfad = "D:\Daten\Bike-Touren\" ' Datenverzeichnis
sDatei = "Bike-Akku.xlsm" ' Dateiname mit Endung in welche die Daten kopiert werden

' Application.ScreenUpdating = False
If Dir(sPfad & sDatei) > "" Then
Workbooks.Open (sPfad & sDatei)
ThisWorkbook.Activate

'Application.ActiveWindow.Visible = False
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("Erfassen") ' Name Tabellenblatt Originaldatei Bike-Erfassen.xlsm
Set WkSh_Z = Workbooks(sDatei).Worksheets("Akku") ' Name Tabellenblatt Bike-Akku.slsm

WkSh_Q.Cells.Range("A12:F171").Copy Destination:=WkSh_Z.Range("A35:F194") ' Datum bis und mit Zwischenladung
WkSh_Q.Cells.Range("H12:H171").Copy Destination:=WkSh_Z.Range("G35:G194") ' Kilometer
WkSh_Q.Cells.Range("Q12:Q171").Copy Destination:=WkSh_Z.Range("H35:H194") ' Höhenmeter

Workbooks(sDatei).Close SaveChanges:=True

Application.ScreenUpdating = True

MsgBox "Die Daten wurden erfolgreich übergeben.", _
64, " Information für " & Application.UserName

End Sub
______________________________________