Extraire les donnees d'une feuille dans un nouveau classeur

Bonjour,

J'ai créer le code ci-dessous mais j'aimerai le perfectionner.

Actuellement, il regroupe les lignes par type de mouvement (OSS, M21 et M22) dans 3 feuillets et ensuite je déplace ces nouveaux feuillets dans 3 classeurs.

Auriez-vous une méthode plus simple?

Par avance merci

Sub Cinder_base_ECRCB()
Dim FEUIL As Worksheet
Application.ScreenUpdating = False 'Empeche le rafraichissement de l'écran

'creation des feuilles automatiquement
Dim cellule As Range
Sheets("Ecriture CB").Select
For Each cellule In Range("S2", Range("S4").End(xlDown))

If cellule.Value <> "" Then
Sheets.Add AFTER:=Sheets(Sheets.Count)
ActiveSheet.Name = cellule.Value
ActiveSheet.Range("N1").Value = "TYPE MOUVEMENT" 'titre du tableau de donnée
ActiveSheet.Range("N2").Value = ActiveSheet.Name ' critère (OSS,M21 et M22)

Sheets("Ecriture CB").Range("I6:Q652").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ActiveSheet.Range("N1:N2"), CopyToRange:=ActiveSheet.Range("A1")
Sheets("Ecriture CB").Select

End If

Next cellule

Application.ScreenUpdating = True

' supprimer la colonne A
Sheets("OSS").Select
Range("A:A,N:N").Select
Selection.Delete Shift:=xlToLeft

Sheets("M21").Select
Range("A:A,N:N").Select
Selection.Delete Shift:=xlToLeft

Sheets("M22").Select
Range("A:A,N:N").Select
Selection.Delete Shift:=xlToLeft

'COPIER VERS UN NOUVEAU CLASSEUR
Sheets("OSS").Select
Sheets("OSS").Move

Windows("LIVRE DE CAISSE ESP CHQ V3.xlsm").Activate
Sheets("M21").Select
Sheets("M21").Move

Windows("LIVRE DE CAISSE ESP CHQ V3.xlsm").Activate
Sheets("M22").Select
Sheets("M22").Move

Windows("LIVRE DE CAISSE ESP CHQ V3.xlsm").Activate
Sheets("Ecriture CB").Select
Range("B7").Select

End Sub

Edit Modo : Lorsque vous postez un code merci d'utiliser les balises de code en cliquant sur l'icone </> disponible dans la barre de menu

Bonjour et bienvenue sur ce forum,

Votre code comme ceci

Sub Cinder_base_ECRCB()
Dim cel As Range

Application.ScreenUpdating = False 'Empeche le rafraichissement de l'écran

'creation des feuilles automatiquement
For Each cel In Sheets("Ecriture CB").Range("S2", Range("S4").End(xlDown))

    If cel.Value <> "" Then
        Sheets.Add AFTER:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = cel.Value
            .Range("N1").Value = "TYPE MOUVEMENT" 'titre du tableau de donnée
            .Range("N2").Value = cel.Value 'ActiveSheet.Name ' critère (OSS,M21 et M22)

            Sheets("Ecriture CB").Range("I6:Q652").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("N1:N2"), CopyToRange:=.Range("A1")
            'Sheets("Ecriture CB").Select 'ligne désactivée car en principe selection non nécessaire
        End With
    End If

Next cel

With Sheets(Array("OSS", "M21", "M22"))
    .Select
    .Range("A:A,N:N").Delete Shift:=xlToLeft
End With

'COPIER VERS UN NOUVEAU CLASSEUR
Sheets(Array("OSS", "M21", "M22")).Move Workbooks("LIVRE DE CAISSE ESP CHQ V3.xlsm").Sheets(1)

Sheets("Ecriture CB").Select
Range("B7").Select
Application.ScreenUpdating = True
End Sub

NB :
- Bonne pratique --> Evitez d'utiliser de nommer des variables qui sont aussi des fonctionnalités de base d'excel (ici Cellule fait partie des formules disponibles).
Pour comprendre tapez =cellule( dans une cellule au hasard d'une feuille.
Dans votre code je l'ai remplacé par CEL
- Votre fichier Livre de caisse doit être ouvert bien entendu.

Si ok et terminé pensez à cloturer le fil lors de votre réponse

Cordialement