Makro ergänzen fummel seit 2 Tagen

Private Sub CommandButton1_Click()
Dim strPath As String
Dim objSh As Worksheet
Dim objWb As Workbook
Dim blnExist As Boolean, blnClose As Boolean
Dim aktWb As Workbook
Set aktWb = ActiveWorkbook
Dim OrdNam1 As String
Dim OrdNam2 As String
Dim OrdNam3 As String
Dim OrdNam4 As String
Dim wwww
strPath = "C:\wwww\aa\"                ' Anpassen!
Set objSh = ActiveSheet
'------- akt. Sheet Name in Zellen setzen ----------
Dim vn As String
vn = ActiveSheet.Name
ActiveSheet.Cells(1, 8).Value = vn
'----------- akt. Sheet Name mit Datum -------------
Dim dn As String
dn = ActiveSheet.Name & "   Umlaufbestand vom  " & Cells(4, 1) & ".xls"
ActiveSheet.Cells(2, 8).Value = dn
'    Range("C3").Select
OrdNam1 = "C:\wwww\"
OrdNam2 = "C:\wwww\" & ActiveSheet.Cells(1, 8).Value
OrdNam3 = ActiveSheet.Cells(1, 8).Value                 'Center Name allein
'für die Erstellung des zusätzlichen Verzeichnisses
OrdNam4 = ActiveSheet.Cells(2, 8).Value                 'Sheet Name allein
If Dir(strPath & OrdNam4) <> "" Then
blnExist = True
' die Zeilen habe ich mal reingesetzt !!!!!!!!!!!!!!!!!!
'---------- ist Center Verzeichnis vorhanden ? ----------------
If Dir(OrdNam2, 16) <> "" Then
MsgBox "IHR Center-Verzeichnis:   " & " "" " & OrdNam3 & " "" " _
& "         ist vorhanden !" & Chr(13) _
& Chr(13) & "Datei:                     " & _
"            "" " & OrdNam4 & " ""         " & Chr(13) & Chr(13) & _
"                        wird jetzt gespeichert !", vbInformation, " Hinweis !"
Application.DisplayAlerts = False                       ' Sicherheitsabfrage unterdrücken
ActiveWorkbook.SaveAs Filename:=(OrdNam2 & "\" & OrdNam4), FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
Else
MsgBox "IHR Center-Verzeichnis:   " & Chr(13) & Chr(13) & _
" "" " & OrdNam3 & " ""            " & Chr(13) & Chr(13) _
& "ist NICHT vorhanden, wird jetzt erstellt !       " & Chr(13) & _
Chr(13) & "Anschließend wird die Datei:   " & Chr(13) & Chr(13) & _
" "" " & OrdNam4 & " ""            " & _
Chr(13) & Chr(13) & "gespeichert ! ", vbInformation, " Hinweis !"
MkDir OrdNam2
Application.DisplayAlerts = False                       ' Sicherheitsabfrage unterdrücken
ActiveWorkbook.SaveAs Filename:=(OrdNam2 & "\" & OrdNam4), FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
End If
'---------------  bis hier ------------------------------------------
If MsgBox("Die Datei" & vbLf & vbLf & vbTab & Chr(34) & strPath & _
OrdNam4 & Chr(34) & _
Space(15) & vbLf & vbLf & "ist bereits vorhanden!" & vbLf & vbLf & _
"Soll die Datei ersetzt werden!", 36, "Frage") = 7 Then
blnClose = True
GoTo ErrExit
End If
End If
For Each objWb In Workbooks
If objWb.FullName = strPath & OrdNam4 Then
If MsgBox("Die Datei" & vbLf & vbLf & vbTab & Chr(34) & objWb.FullName & Chr(34) & _
Space(15) & vbLf & vbLf & "ist zur Zeit geöffnet!" & vbLf & vbLf & _
"Um fortzufahren, muss die Datei geschlossen werden!", 33, "Frage") = 2 Then
blnClose = True
GoTo ErrExit
End If
ActiveWorkbook.Save                 'neu gesetzt
objWb.Close False               'alte Mappe
Exit For
End If
Next
objSh.Copy
With ActiveWorkbook
Application.DisplayAlerts = False                 ' Sicherheitsabfrage unterdrücken
.SaveAs strPath & OrdNam4              '<<<<<<<<<<< hier bleibt stehen
'aktWb.Activate           'Ursprung vom kopieren  'alte Datei, aktivieren
'.Close True
End With
ErrExit:
If Err.Number = 0 Then
If blnClose Then
MsgBox "Der Vorgang wurde Abgebrochen!  ", 64, "Hinweis"
Exit Sub                'ich eingesetzt bei NEIN 13-7-06
Else
MsgBox "Die Datei" & vbLf & vbLf & vbTab & strPath & _
OrdNam4 & Space(15) & _
vbLf & vbLf & "wurde erfolgreich " & IIf(blnExist, "ersetzt", "erstellt") & "!", 64, "Hinweis"
End If
Else
'MsgBox "Beim speichern der Datei" & vbLf & vbLf & vbTab & strPath & objSh.Name & ".xls" & Space(15) & _
'    vbLf & vbLf & "trat folgender Fehler auf" & vbLf & vbLf & Err.Description & Space(15), 48, "Fehler"
Err.Clear
End If
Set objSh = Nothing
'- hier die erstellte Datei rein -----------
Dim aaw
'MsgBox ActiveWorkbook.Name
Set aaw = ActiveWorkbook
aktWb.Activate
With ActiveWorkbook
If .Name Like "Umlauf.xls" Then
''' MsgBox "Es wird vom Orginal kopiert, wird nichts gemacht !    "
Else
With ActiveWorkbook
If Not .Name Like "Center*" Then
MsgBox "Die Datei " & vbLf & vbLf & .Name & vbLf & vbLf & _
"wird jetzt geschlossen, diese können Sie später löschen !    "
strPath = aktWb.Path & "\" & aktWb.Name
aktWb.Close
Kill strPath
Else
MsgBox "Die Datei " & vbLf & vbLf & .Name & vbLf & vbLf & _
"hat einen CENTER-Namen, wird nicht gelöscht !   "
End If
End With
End If
End With
aaw.Activate
End Sub