Hallo HaJo,
ein Upload der Datei ist nicht möglich, da diese 1,3 Mb groß ist und eine Verringerung der Eintragungen ist auch nicht möglich, da viele schon im Bezug auf andere Zellen stehen....
Außerdem musste ich viel mit Verbundenen Zellen machen, damit eine einigermaßen ansehnliche Oberfläche zustande kommt.
Was ich machen kann, das gesamte Makro hier einstellen....
Sub loeschen()
' loeschen Makro
' Löscht alle Eingaben
' Tastenkombination: Strg+ö
If MsgBox("Wollen Sie die Daten wirklich löschen?", vbCritical Or vbYesNo, "S i c h e r h e i t _
s f r a g e !") = vbYes Then
Application.EnableEvents = False
Range("R4:U5,Z4:AR5,AW4:BO5,BT4:CS5,CX4:DP5").Select
Range("CX4").Activate
Selection.ClearContents
Range( _
"P21:U21,P22:U22,P24:U24,AM21:AR21,AM24:AR24,BJ21:BO21,BJ24:BO24,CJ21:CP21,CJ22:CP22, _
CJ24:CP24,DK21:DP21,DK22:DP22,DK24:DP24,EH21:EM21,EH22:EM22,EH24:EM24" _
).Select
Range("EH24").Activate
Selection.ClearContents
Range( _
"P28:U28,P29:U29,P31:U31,AM28:AR28,AM31:AR31,BJ28:BO28,BJ31:BO31,CJ28:CP28,CJ29:CP29, _
CJ31:CP31,DK28:DP28,DK29:DP29,DK31:DP31,EH28:EM28,EH29:EM29,EH31:EM31" _
).Select
Range("EH31").Activate
Selection.ClearContents
Range( _
"P35:U35,P36:U36,P38:U38,AM35:AR35,AM38:AR38,BJ35:BO35,BJ38:BO38,CJ35:CP35,CJ36:CP36, _
CJ38:CP38,DK35:DP35,DK36:DP36,DK38:DP38,EH35:EM35,EH36:EM36,EH38:EM38" _
).Select
Range("EH38").Activate
Selection.ClearContents
Range( _
"P42:U42,P43:U43,P45:U45,AM42:AR42,AM45:AR45,BJ42:BO42,BJ45:BO45,CJ42:CP42,CJ43:CP43, _
CJ45:CP45,DK42:DP42,DK43:DP43,DK45:DP45,EH42:EM42,EH43:EM43,EH45:EM45" _
).Select
Range("EH45").Activate
Selection.ClearContents
Range( _
"P49:U49,P50:U50,P52:U52,AM49:AR49,AM52:AR52,BJ49:BO49,BJ52:BO52,CJ49:CP49,CJ50:CP50, _
CJ52:CP52,DK49:DP49,DK50:DP50,DK52:DP52,EH49:EM49,EH50:EM50,EH52:EM52" _
).Select
Range("EH52").Activate
Selection.ClearContents
Range( _
"P56:U56,P57:U57,P59:U59,AM56:AR56,AM59:AR59,BJ56:BO56,BJ59:BO59,CJ56:CP56,CJ57:CP57, _
CJ59:CP59,DK56:DP56,DK57:DP57,DK59:DP59,EH56:EM56,EH57:EM57,EH59:EM59" _
).Select
Range("EH59").Activate
Selection.ClearContents
Range("AM69:AR69,AM70:AR70,BJ69:BO69,BJ70:BO70,BJ72:BO72").Select
Range("BJ72").Activate
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-63
Range("R4:U5").Select
End If
If MsgBox("Alle Eingaben wurden gelöscht !", vbInformation, "H i n w e i s !") = vbYes Then
Application.EnableEvents = False
Range("R4").Select
End If
End Sub