Hallo Thomas,
vielen Dank erstmal für die rasche Antwort.
Kenne mich leider noch nicht sooo gut aus, deshalb hier mal mein Code.
Wie könnte dieser denn ohne "select" ausschauen?
Danke! Gruß Thomas
Ist ein ganz schöner Brocken:
Sub SICHERN_DER_MAPPE_UND_NEUES_JAHR_BeiKlick()
Dim wks1 As Worksheet
Dim strPfad As String
Dim ant As String
Dim s As Byte
Dim gesamt As Byte
ant = Msgbox("Mit diesem Vorgang ändern Sie den Kalender und Speichern
eine reduzierte Version dieser Mappe in den Ordner Sicherungskopien.
Ein Rückgängigmachen ist nach Bestätigung nicht mehr möglich!
***Dieser Vorgang dauert ca. 3 Minute***
Möchten Sie fortfahren?",
vbYesNo)
If ant = vbNo Then
Exit Sub
Else
Application.ScreenUpdating = False
Application.DisplayAlerts = False
strPfad = ThisWorkbook.Path & "\Sicherungskopien\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & "_" & Day(Date) &
_
"." & Month(Date) & "." & Year(Date)& "_Sicherungskopie.xls"
ThisWorkbook.SaveCopyAs strPfad
Workbooks.Open strPfad
Call Werkskalenderfixierung
Call Load_Übersicht_FIXIERUNG
Call löschen
gesamt = Sheets.Count
For s = 1 To gesamt
Sheets(s).visible = True
Next
' hier werden Makros gelöscht
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.
_
VBComponents("Uploader")
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.
_
VBComponents("SICHERN_UND_NEUES_JAHR")
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.
_
VBComponents("Schieber1_40h_Woche_neu")
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.
_
VBComponents("Schieber2_Schichten_neu")
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.
_
VBComponents("Schieber_Masch_Tage_neu")
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.
_
VBComponents("Pool_Namen_Uploader")
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.
_
VBComponents("Gibt_Blatt_Namen")
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.
_
VBComponents("BLATTWECHSEL")
ActiveWorkbook.Save
ActiveWorkbook.Close
Call verschieben_Jahre
Msgbox "Eine Sicherungskopie dieser Mappe wurde in " & vbCr & vbCr &
strPfad & " abgelegt !", _
vbInformation, " Sicherungskopie"
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub Werkskalenderfixierung()
'Application.ScreenUpdating = False
Sheets("SUMME_SHEET").Select
ActiveSheet.Unprotect
Range("D3:AX7").Select
Selection.Copy
Range("D3:AX7").Select
Selection.PasteSpecial Paste:=xlValues
ActiveSheet.Protect DrawingObjects:=True, contents:=True,
Scenarios:=True
Range("a1").Select
End Sub
-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub Load_Übersicht_FIXIERUNG()
'Application.ScreenUpdating = False
Sheets("Load_Übersicht").Select
ActiveSheet.Unprotect
Range("1:25").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
ActiveSheet.Protect DrawingObjects:=True, contents:=True,
Scenarios:=True
Range("a1").Select
End Sub
-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub verschieben_Jahre()
Dim z As Byte
Dim Pools As Byte
Dim x As Byte
Dim VERG_POOLS As Byte
For Pools = 2 To 21
Sheets(Pools).Activate
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Range("U13:AF27").Select 'oberer Teil von
Jahr_zwei
Selection.Copy
Range("F13:Q27").Select 'oberer Teil von
Jahr_eins
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone,
SkipBlanks:= False, Transpose:=False
Range("U35:AF91").Select 'unterer Teil von
Jahr_zwei
Selection.Copy
Range("F35:Q91").Select 'unterer Teil von
Jahr_eins
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone,
SkipBlanks:= False, Transpose:=False
Range("AJ13:AU27").Select 'oberer Teil von Jahr_drei
Selection.Copy
Range("U13:AF27").Select 'oberer Teil von Jahr_zwei
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone,
SkipBlanks:= False, Transpose:=False
Range("AJ35:AU91").Select 'unterer Teil von Jahr_drei
Selection.Copy
Range("U35:AF91").Select 'unterer Teil von Jahr_zwei
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone,
SkipBlanks:= False, Transpose:=False
Range("leer").Cells = 0
Range("Load3").Cells = 0
Range("AJ20:AU20,AJ35:AU35").Cells = 5
Range("A1").Select
ActiveSheet.Protect
Next
Sheets("SUMME_SHEET").Activate
ActiveSheet.Unprotect
Range("F4") = Range("F4") + 364.25
Range("B2").Select
ActiveSheet.Protect DrawingObjects:=True, contents:=True,
Scenarios:=True
'Jahr im VERG-Sheet
For VERG_POOLS = 22 To 41
Sheets(VERG_POOLS).visible = True
Sheets(VERG_POOLS).Select
ActiveSheet.Unprotect
'Jahr(1) wird genullt:
If Range("D6") = 1 Then
Range("k12,k13,F10:J10,F20:J21,k27,k34").Cells = ""
Range("p12,p13,L10:O10,l20:o21,p27,p34").Cells = ""
Range("u12,u13,Q10:T10,q20:t21,u27,u34").Cells = ""
Range("aa12,aa13,V10:Z10,v20:z21,aa27,aa34").Cells = ""
Range("af12,af13,AB10:AE10,ab20:ae21,af27,af34").Cells = ""
Range("ak12,ak13,AG10:AJ10,ag20:aj21,ak27,ak34").Cells = ""
Range("aq12,aq13,AL10:AP10,al20:ap21,aq27,aq34").Cells = ""
Range("av12,av13,AR10:AU10,ar20:au21,av27,av34").Cells = ""
Range("ba12,ba13,AW10:AZ10,aw20:az21,ba27,ba34").Cells = ""
Range("bg12,bg13,BB10:BF10,bb20:bf21,bg27,bg34").Cells = ""
Range("bl12,bl13,BH10:BK10,bh20:bk21,bl27,bl34").Cells = ""
Range("bq12,bq13,BM10:BP10,bm20:bp21,bq27,bq34").Cells = ""
Else
Range("k10,k12,k13,k20,k21,k27,k34").Cells = ""
Range("p10,p12,p13,p20,p21,p27,p34").Cells = ""
Range("u10,u12,u13,u20,u21,u27,u34").Cells = ""
Range("aa10,aa12,aa13,aa20,aa21,aa27,aa34").Cells = ""
Range("af10,af12,af13,af20,af21,af27,af34").Cells = ""
Range("ak10,ak12,ak13,ak20,ak21,ak27,ak34").Cells = ""
Range("aq10,aq12,aq13,aq20,aq21,aq27,aq34").Cells = ""
Range("av10,av12,av13,av20,av21,av27,av34").Cells = ""
Range("ba10,ba12,ba13,ba20,ba21,ba27,ba34").Cells = ""
Range("bg10,bg12,bg13,bg20,bg21,bg27,bg34").Cells = ""
Range("bl10,bl12,bl13,bl20,bl21,bl27,bl34").Cells = ""
Range("bq10,bq12,bq13,bq20,bq21,bq27,bq34").Cells = ""
End If
Cells(7, 1) = Cells(7, 1) + 1
ActiveSheet.Protect
ActiveSheet.visible = False
Range("F10").Select
Next
End Sub
---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub löschen()
'Hier die Namen der Sheets eintragen die in der Kopie gelöscht werden
sollen
Dim P As Integer
Dim V As Integer
A = Sheets(1).Range("G2")
For P = 21 To A + 2 Step -1
Sheets(P).Unprotect
Sheets(P).Delete
Next P
For V = 41 - (20 - A) To 2 * A + 2 Step -1
Sheets(V).Unprotect
Sheets(V).Delete
Next
Sheets("Uploader").Delete
Sheets("Werkskalender").Delete
Sheets("PLANT_UPLOAD_FILE").Delete
Sheets("PLANT_UPLOAD_FILE Template").Delete
End Sub