Code vorzeitig verlassen

Sub kopieren() Dim zSh As Worksheet ' z wie Ziel Dim StDatei As String StDatei = "Quelle_" & Format(Date, "dd.mm") Set zSh = Workbooks("Ziel.xlsm").Worksheets("Tabelle1") zSh.Unprotect Workbooks(StDatei & ".xlsm").Worksheets("Tabelle1").Range("A1:F30").Copy With zSh.Range("A1") .PasteSpecial Paste:=xlValues .PasteSpecial Paste:=xlFormats End With Application.CutCopyMode = False zSh.Range("A1:A30").Locked = False zSh.Range("B1:E30").Locked = True zSh.Range("F1:F30").Locked = False zSh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True zSh.EnableSelection = xlUnlockedCells End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Function WkbExists(sFile As String) As Boolean Dim wkb As Object On Error Resume Next Set wkb = Workbooks(sFile) If Not wkb Is Nothing Then WkbExists = True End If On Error GoTo 0 End Function

Hi Markus,
es rächt sich immer wieder, wenn man nicht mit "Option explicit" arbeitet. Das gehört einfach in die erste Zeile eines jeden Moduls bzw. im VBA-Editor unter Extras/Optionen angehakt:
Userbild

Der Punkt ist nämlich, daß die Variable StDatei zwar in der Sub kopieren deklariert ist, nicht jedoch in DateiOeffnen: also wird sie dort als Leerstring neu angelegt.
Also, hier in Modul1:

Option Explicit
Sub kopieren()
Dim zSh As Worksheet ' z wie Ziel
Dim StDatei As String, StPfad As String
Dim ImportWB As Workbook
Set zSh = Worksheets("Tabelle1")
StDatei = "Quelle_" & Format(Date, "DD.MM") & ".xlsx"
' *** auf xlsx geändert; falls xlsm halt wieder ersetzen
StPfad = ThisWorkbook.Path & "\" & StDatei
If WkbExists(StDatei) = False Then
If Dir(StPfad) = "" Then
MsgBox "Datei " & StPfad & " wurde nicht gefunden!"
Exit Sub
Else
Workbooks.Open StPfad ' evtl. readonly=true?!
' hier der komplette Pfad für Laufwerks-Zugriff
End If
Else
Workbooks(StDatei).Activate
' hier nur der Name der bereits geöffneten Datei
End If
zSh.Unprotect
' zu diesem Zeitpunkt ist StDatei das "ActiveWorkbook"
ActiveWorkbook.Worksheets("Tabelle1").Range("A1:F30").Copy zSh.Range("A1")
' wenn sonst nichts zu kopieren ist, gleich wieder schließen
ActiveWorkbook.Close False ' ohne Speichern
' jetzt ist die ohnehin geöffnete Datei wieder das ActiveWorkbook
Application.CutCopyMode = False
zSh.Range("A1:A30").Locked = False
zSh.Range("B1:E30").Locked = True
zSh.Range("F1:F30").Locked = False
zSh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
zSh.EnableSelection = xlUnlockedCells
End Sub
Private Function WkbExists(sFile As String) As Boolean
Dim wkb As Object
On Error Resume Next
Set wkb = Workbooks(sFile)
If Not wkb Is Nothing Then
WkbExists = True
End If
On Error GoTo 0
End Function

Schöne Grüße,
Michael

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread