Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.10.2025 10:28:49
16.10.2025 17:40:39
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Automatische Sicherheitskopie eines Bereichs

Forumthread: Automatische Sicherheitskopie eines Bereichs

Automatische Sicherheitskopie eines Bereichs
30.04.2019 09:32:17
alex_de_souza
Hallo,
mit dem folgenden Code wird jedesmal beim Speichern der Originaldatei eine Sicherungskopie gespeichert. Das klappt auch wunderbar. Nur wird immer die gesamte Datei gespeichert.
Ist es möglich, dass in der Sicherungskopie nur der Bereich von B4 bis I40 gespeichert wird? Dieser Bereich sollte in der Sicherungskopie ab B2 eingefügt werden.
Anbei mein Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim WbZ As Workbook
Dim Pfad$, Dname$
Pfad = "S:\Tools\"
Dname = "Test.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Me
If Not .ReadOnly And SaveAsUI = False Then
.Sheets.Copy
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

Vielen dank.
Lg
Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Automatische Sicherheitskopie eines Bereichs
30.04.2019 11:44:58
UweD
Hallo
so?
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

LG UweD
Anzeige
geht oben weiter
30.04.2019 14:49:49
UweD
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige