Problème macro VBA

Sub new_credit_note()
[B][COLOR=blue]Dim RefAnc As String, RefActuel As String[/COLOR][/B]
'Macro créée par LABIT
'************ NOUVEAU 09 MARS 2009 - à rajouter ************
'Informer le fichier que le numéro a changé
    Range("logique").Value = "oui"
'************ Fin nouveauté ***************
[COLOR=blue][B]'on cherche la dernière référence enregistrée
RefActuel = Left(Dir("C:\Demande avoir\"), 11)
Do
  If RefActuel > RefAnc Then RefAnc = RefActuel
  RefActuel = Left(Dir(), 11)
Loop Until RefActuel = ""[/B][/COLOR]
[COLOR=blue][B]    Range("B1").Value = RefAnc
    Range("I1").Value = Range("B1").Value
[/B][/COLOR]    Range("I1").Select
    ActiveCell.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False 'Enlever les espaces en trop
    Application.CutCopyMode = False
   Range("I1").Value = Range("I1").Value + 1 'Ancien N° d'avoir + 1
   alpha = Range("I1").Value
   'Retenir les 6 chiffres qui composent le nouveau n° d'avoir
   beta = Mid(alpha, 1, 1)
   gamma = Mid(alpha, 2, 1)
   Delta = Mid(alpha, 3, 1)
   epsilon = Mid(alpha, 4, 1)
   zeta = Mid(alpha, 5, 1)
   eta = Mid(alpha, 6, 1)
   'Reconstituer un n° d'avoir avec les espaces
   theta = beta & " " & gamma & " " & Delta & " " & epsilon & " " & zeta & " " & eta
   Range("I1").ClearContents 'Effacer en I1
   Range("B1").Value = theta 'Insérer le nouveau n° d'avoir
'Enregistrer dans un répertoire par numéro
ChDir "C:\Demande avoir"
ActiveWorkbook.SaveAs Filename:= _
    "C:\Demande avoir\" & theta & Range("B6") & ".xlsm.xls", _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    
'Définir la zone d'impression
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$33"
'Imposer de sortir l'avoir sur 1 page (max 1 de large et max 1 de haut)
With ActiveSheet.PageSetup
        .FitToPagesWide = 1
        .FitToPagesTall = 1
End With
'Ouvrir Aperçu avant impression
ActiveWindow.SelectedSheets.PrintPreview
End Sub