Blattschutz ohne Makro zu stören

Private Sub CommandButton1_Click()
Dim z, nr, zz
z = 22
For nr = 1 To 29
With Sheets("Produktgruppe" & Trim(Str(nr)))
For zz = 3 To 1000
If .Cells(zz, 2)  "" Then
Cells(z, 8) = .Cells(zz, 2)
Cells(z, 10) = .Cells(zz, 4)
Cells(z, 12) = .Cells(zz, 3)
Cells(z, 14) = .Cells(zz, 7)
Cells(z, 16) = .Cells(zz, 5)
Cells(z, 18) = .Cells(zz, 6)
Cells(z, 22) = .Cells(zz, 8)
Cells(z, 24) = .Cells(zz, 9)
Cells(z, 26) = .Cells(zz, 10)
z = z + 2
End If
Next zz
End With
Next nr
End Sub

Private Sub CommandButton2_Click()
Dim nr As Long
For nr = 1 To 29
With Sheets("Produktgruppe" & CStr(nr))
If .Cells(.Rows.Count, 2).End(xlUp).Row > 2 Then
.Range(.Cells(3, 2), .Cells(.Cells(.Rows.Count, 2) _
.End(xlUp).Row, 2)).ClearContents
End If
If .Cells(.Rows.Count, 3).End(xlUp).Row > 2 Then
.Range(.Cells(3, 3), .Cells(.Cells(.Rows.Count, 3) _
.End(xlUp).Row, 3)).ClearContents
End If
End With
Next nr
Range("H22:xZ200").Select
Selection.ClearContents
Range("H22").Select
End Sub

Private Sub CommandButton4_Click()
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String, wksMail As Worksheet
Set wksMail = Sheets(3)
AWS = Environ("USERPROFILE") & "\" & wksMail.Name & ".xls"
'temporäre Mappe erstellen
wksMail.Copy
With ActiveWorkbook
.SaveAs AWS
.Close
End With
Application.Visible = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "test@test.at"
.Cc = Range("R11")
.Subject = "Materialanforderung zu " & Range("L13")
.Attachments.Add AWS
.Body = "Hallo, anbei eine Materialanforderung bitte um Bearbeitung. Siehe File in der  _
Anlage. Danke" & vbCrLf & ""
.Display
End With
Set OutApp = Nothing
Set Nachricht = Nothing
Kill AWS 'temporäre Mappe löschen
End Sub

Private Sub DTPicker21_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal   _
_
_
CallbackField As String, CallbackDate As Date)
End Sub