Macro - Changement de valeur, copier les données dans un nouveau classeur

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cr As String 'déclare la variable cr (CRitère)

If Target.Column <> 2 Then Exit Sub 'si le changement a lieu ailleurs que dans la colonne 2, sort de la procédure
If Target.Row = 1 Then Exit Sub 'si le changement a lieu dans la ligne 1, sort de la procédure (normalement elle contient les étiquettes de données, à adapter voire supprimer...)
If Target.Value <> "" Then cr = Cstr(Target.Value) 'si la cellule éditée n'a pas été effacée, définit le critère cr
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cr As String 'déclare la variable cr (CRitère)
Dim cs As Workbook 'déclare la variable cs (Classeur Source)
Dim cc As Workbook 'déclare la variable cc (Classeur Cible)
Dim os As Object 'déclare la variable os (Onglet Source)
Dim oc As Object 'déclare la variable oc (Onglet Cible)

If Target.Column <> 2 Then Exit Sub 'si le changement a lieu ailleurs que dans la colonne 2, sort de la procédure
If Target.Row = 1 Then Exit Sub 'si le changement a lieu dans la ligne 1, sort de la procédure (normalement elle contient les étiquettes de données, à adapter voire supprimer...)
If Target.Value <> "" Then cr = CStr(Target.Value) 'si la cellule éditée n'a pas été effacée, définit le critère cr
Set cs = ThisWorkbook 'définit la classeur source
Set os = cs.Sheets("Feuil1") 'définit l'onglet source (à adapter)
Workbooks.Add 'ajjoute un nouveau classeur vierge
Set cc = ActiveWorkbook 'définit le classeur cible
Set oc = cc.Sheets("Feuil1") 'définit l'obglet cible
With os 'prend en compte l'onglet source
    .ShowAllData 'affiche toutes les lignes
    .Range("$A$1:$z$6000").AutoFilter Field:=2, Criteria1:=cr 'filtre
    .Range("A1").CurrentRegion.Copy oc.Range("A1") 'copie les lignes du filtre et les colle dans A1
End With 'fin de la prise en compte de l'Onglet Source
oc.Name = cr 'renome l'onglet cible
Application.Windows(cs.Name).Activate 'revient au classeur source
Sheets("tempMain3399597634961954733").Select 'sélectionne l'onglet
End Sub

Sheets("tempMain3399597634961954733").Select 'sélectionne l'onglet

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cr As String 'déclare la variable cr (CRitère)
Dim cs As Workbook 'déclare la variable cs (Classeur Source)
Dim chem As String 'déclare la variable chem (CHEMin d'accès)
Dim cc As Workbook 'déclare la variable cc (Classeur Cible)
Dim os As Object 'déclare la variable os (Onglet Source)
Dim oc As Object 'déclare la variable oc (Onglet Cible)

If Target.Column <> 2 Then Exit Sub 'si le changement a lieu ailleurs que dans la colonne 2, sort de la procédure
If Target.Row = 1 Then Exit Sub 'si le changement a lieu dans la ligne 1, sort de la procédure (normalement elle contient les étiquettes de données, à adapter voire supprimer...)
If Target.Value <> "" Then cr = CStr(Target.Value) 'si la cellule éditée n'a pas été effacée, définit le critère cr
Set cs = ThisWorkbook 'définit la classeur source
chem = cs.Path & "\" 'définit la variable chem
Set os = cs.Sheets("Feuil1") 'définit l'onglet source (à adapter)
Workbooks.Add 'ajoute un nouveau classeur vierge
Set cc = ActiveWorkbook 'définit le classeur cible
Set oc = cc.Sheets("Feuil1") 'définit l'obglet cible
With os 'prend en compte l'onglet source
        If .FilterMode = True Then .ShowAllData 'affiche toutes les lignes si le filtre automatique a été appliqué
    .Range("$A$1:$z$6000").AutoFilter Field:=2, Criteria1:=cr 'filtre
    .Range("A1").CurrentRegion.Copy oc.Range("A1") 'copie les lignes du filtre et les colle dans A1
End With 'fin de la prise en compte de l'Onglet Source
oc.Name = cr 'renome l'onglet cible
cc.SaveAs (chem & "Juillet2012-" & cr & ".xlsx") 'enregistre le classeur
Application.Windows(cs.Name).Activate 'revient au classeur source
os.Range("A1").AutoFilter 'supprime le filtre automatique de l'onglet source
Sheets("tempMain3399597634961954733").Select 'sélectionne l'onglet
End Sub