VBA Makro nach bedingung ausführen
18.07.2006 20:04:31
Alexandra
und danke für Hilfe die ich hier schon erfahren habe
Nun habe ich ein neues Problem ich möchte u.g. Makro nur Ausführen lassen wenn die geöffnete *xls Datei "Statistik 2006 v.2.01" heist.
d.h. wenn die Datei unter einem anderen Namen geöffnet wird soll das Makro inaktiv sein.
Sub Löschen()
ActiveSheet.Unprotect
Range("S5:S16").Copy
Range("T5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Statistik").Select
ActiveSheet.Unprotect
Sheets("Eingabefeld").Select
Range("M2").Copy
Range("L1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Dim freieZ As Long
With Sheets("Statistik")
freieZ = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Eingabefeld").[c5:k5].Copy Destination:=.Cells(freieZ, 1)
freieZ = freieZ + 1
Sheets("Eingabefeld").[c6:k6].Copy Destination:=.Cells(freieZ, 1)
freieZ = freieZ + 1
Sheets("Eingabefeld").[c7:k7].Copy Destination:=.Cells(freieZ, 1)
freieZ = freieZ + 1
Sheets("Eingabefeld").[c8:k8].Copy Destination:=.Cells(freieZ, 1)
freieZ = freieZ + 1
Sheets("Eingabefeld").[c9:k9].Copy Destination:=.Cells(freieZ, 1)
freieZ = freieZ + 1
Sheets("Eingabefeld").[c10:k10].Copy Destination:=.Cells(freieZ, 1)
freieZ = freieZ + 1
Sheets("Eingabefeld").[c11:k11].Copy Destination:=.Cells(freieZ, 1)
freieZ = freieZ + 1
Sheets("Eingabefeld").[c12:k12].Copy Destination:=.Cells(freieZ, 1)
freieZ = freieZ + 1
Sheets("Eingabefeld").[c13:k13].Copy Destination:=.Cells(freieZ, 1)
freieZ = freieZ + 1
Sheets("Eingabefeld").[c14:k14].Copy Destination:=.Cells(freieZ, 1)
freieZ = freieZ + 1
Sheets("Eingabefeld").[c15:k15].Copy Destination:=.Cells(freieZ, 1)
freieZ = freieZ + 1
Sheets("Eingabefeld").[c16:k16].Copy Destination:=.Cells(freieZ, 1)
End With
Sheets("Statistik").Select
Columns("J:J").Copy
Columns("K:K").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = False
Columns("F:K").Select
Range("K1").Activate
Selection.ColumnWidth = 0
Columns("B:C").Select
Range("C1").Activate
Selection.ColumnWidth = 0
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Eingabefeld").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.SaveAs "D:\users\" & Month(Now) & "." & (Year(Now) & " Statistikdat" & _
Range("I2").Value & ".XLS")
Application.DisplayAlerts = True
Sheets("Übergabebogen").Select
Range("Q14:Q25").ClearContents
Range("Q14").Select
Sheets("Eingabefeld").Select
Range("I1").Copy
Range("I2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C5:L5").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("C6:L16").ClearContents
Range("P5:P16").Copy
Range("I5").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("Q5:Q16").Copy
Range("F5").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("B5").ClearContents
Range("B5").Select
ActiveWindow.ScrollColumn = 1
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "D:\users\" & "Statistik 2006 v.2.01" & ".XLS"
End Sub