Kann mal jemand diesen Code überprüfen

Private Sub CommandButton3_Click()
Dim DName As String, aktDir As String
Dim strPath As String
Dim intC As Integer
Dim obj As OLEObject
Dim rng As Range
strPath = "C:\Winnt\Profiles\xflb21\Eigene Dateien\Sicherung_xls" 'Speicherort
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Application.ScreenUpdating = False
ActiveSheet.Copy    'aktives Blatt kopieren  'Hier Stoppt der Code
With ActiveWorkbook
With .Sheets(1)
.Unprotect "test"   'Blattschutz aufheben - Passwort anpassen
For Each obj In .OLEObjects
obj.Delete          'Schaltflächen löschen
Next
For Each rng In .Cells.SpecialCells(xlCellTypeFormulas, 23)
rng = rng.Value     'Formeln entfernen
Next
.[Q3].Validation.Delete 'Dropdownliste entfernen
.Cells.Locked = True    'alle Zellen sperren
.Protect "test"         'Blatt schützen - Passwort anpassen
End With
'VBA-Code entfernen
'With .VBProject.VBComponents("Tabelle1").CodeModule
'    .DeleteLines 1, .CountOfLines
'End With
DName = strPath & "Blatt1" & " " & [A1] & " " & Format(Now, "DD-MM-YY") & ".xls"
.SaveAs DName ' speichere unter Name Inhalt von Zelle A1 & Datum.xls
.Close  'Sicherungskopie schliessen
MsgBox "Kopie erfolgreich unter " & strPath & "\ gespeichert."
MsgBox "Drucker Ausgabe aktiviert !!  2 Kopien werden erstellt."
End With
Application.ScreenUpdating = True
' Druck starten & alle Eingaben aus Tabelle löschen
ActiveSheet.PageSetup.PrintArea = "$A$1:$Z$40"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Range("K3:M3,Q3,A7:Z31,F34:H40,P35:P40,V34") = ""
Application.ScreenUpdating = True
Exit Sub
End Sub