Erreur Automation

Bonjour,

J'ai un fichier avec plusieurs onglets. Je souhaite créer un nouveau classeur pour chaque onglet et sauvegarder ces classeurs dans un répertoire.

Ci-dessous le code que j'ai créé mais qui ne fonctionne pas..

For Each Feuille In ActiveWorkbook.Worksheets
    Feuille.Activate
    If Feuille.UsedRange.Cells.Address = "$A$1" And IsEmpty(Feuille.Range("A1")) And Feuille.Shapes.Count = 0 Then
        Application.DisplayAlerts = False
        Feuille.Delete
        Application.DisplayAlerts = True
    ElseIf Feuille.Name <> "Feuil1" And Feuille.Name <> "Feuil2" Then
        Feuille.Move
        ActiveWorkbook.Title = Feuille.Name
        ActiveWorkbook.subject = Feuille.Name
        ActiveWorkbook.SaveAs Filename:=chemin & Feuille.Name & ".xlsx"
    End If
Next Feuille

Ca affiche un message d'erreur "Erreur Automation" en arrivant à la ligne suivante :

ActiveWorkbook.Title = Feuille.Name

Je ne sais pas du tout comment résoudre ce problème ni à quoi est dûe l'erreur..

Merci de votre aide !

Cordialement,