leider konnte ich auf den letzten Beitrag nicht mehr antworten. Vielen Dank für die Antwort Uwe.
@all:
Ich habe von Uwe folgenden Code bekommen:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim WbZ As Workbook, TBA As Worksheet, TBN As Worksheet
Dim Pfad$, Dname$
Pfad = "S:\Tools\"
Dname = "Test.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Me
Set TBA = .Sheets(1)
If Not .ReadOnly And SaveAsUI = False Then
Set TBN = .Sheets.Add(After:=Sheets(Sheets.Count)) 'neues Blatt
TBN.Range("B2:I38").Value = TBA.Range("B4:I40").Value 'Bereich auf neues Blatt ü _
bertragen
TBN.Move 'Blatt in eigenen Datei verschieben
Set WbZ = ActiveWorkbook
With WbZ
.SaveAs Filename:=Pfad & Dname, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close True
End With
End If
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Der klappt auch wunderbar und es wird beim Speichern immer bei dem festgelegten Pfad eine Sicherheitskopie angelegt. Leider wird nur bei den Zellen, die noch leer sind in der Sicherheitskopie immer NV angezeigt. Kann man festlegen, dass in dem Bereich B4 bis I40 nur bis zu der letzten Zeile mit Inhalt kopiert wird?
LG