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

[esperluette]

Bonjour,

Je souhaiterais créer une macro, qui à partir d’une feuille source :
- à chaque changement de valeur à la colonne 2 (par exemple), on fait un filtre sur cette valeur
- on copie les lignes associées à cette valeur
- et qu’on colle ces lignes dans un nouveau classeur dont le nom de ce nouveau classeur porte la valeur sélectionnée.
J’ai testé de faire cette macro, où le changement de valeur est « manuel ».
Dans cet exemple, la valeur est « 7402 », puis on a la suite avec « 7406 ».
Selection.AutoFilter

ActiveSheet.Range("$A$1:$z$6000").AutoFilter Field:=18
ActiveSheet.Range("$A$1:$z$6000").AutoFilter Field:=2, Criteria1:="7402"
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Feuil1").Name = "Feuil1"
Range("A1").Select
ActiveSheet.Paste
Sheets("Feuil1").Select
Sheets("Feuil1").Name = "7402"

Sheets("Classeur1").Select


ActiveSheet.Range("$A$1:$W$3029").AutoFilter Field:=2, Criteria1:="7406"
Rows("1:1").Select
Selection.CurrentRegion.Select
Application.CutCopyMode = False
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Sheets("Feuil2").Select
Sheets("Feuil2").Name = "7406"
Range("D34").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
End Sub

Je ne sais pas comment mettre en VBA le changement de valeur.

Merci de votre aide
Cordialement

 

[Robert]

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

Boujour Esperluette et bienvenue, bonjour le forum,

Une base de départ avec la macro événementielle Change à placer dans l'onglet où tu veux qu'elle agisse :

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

Il te suffit ensuite d'tuliliser cette variabe : Criteria1:=cr
Si ça suffit pas je reste attentif à ton fil...

 

[esperluette]

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

Merci
Mais je suis désolée je n'ai aucune connaissance sur VBA et je ne vois pas comment insérer vos commentaires...
Une aide supplémentaire m'est nécessaire!

Sub Macro1240712()
'
' Macro1240712 Macro
'


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
Range("H1").Select
Selection.AutoFilter

ActiveSheet.Range("$A$1:$z$6000").AutoFilter Field:=18
ActiveSheet.Range("$A$1:$z$6000").AutoFilter Field:=2, Criteria1:=cr
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count) ==> là je dois insérer un nouveau classeur pas une nouvelle feuille c'est ça?
Sheets("Feuil1").Name = "Feuil1"
Range("A1").Select
ActiveSheet.Paste
Sheets("Feuil1").Select
Sheets("Feuil1").Name = cr

Sheets("tempMain3399597634961954733").Select

End Sub

 

[Robert]

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

Bonjour Esperluette, bonjour le forum,

Si tu ne mets pas un fichier exemple en pièce jointe je n'irai pas plus loin ! Car il faut être aussi devin et ça me gave...

Nouvelle proposition :

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

 

[esperluette]

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

Merci pour votre réponse!
Ci-joint un fichier simplifié, dans lequel c'est sur la colonne 2 qu'on travaille: pour une valeur on copie toutes les lignes qui ont la même valeur dans la colonne 2 au sein d'un nouveau fichier. Et ce nouveau fichier aura pour nom "Juillet2012-Valeur"

 

[Robert]

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

Bonjour Esperluette, bonjour le forum,

Le code que je t'ai proposé fonctionne mais il y a plusieurs problèmes à résoudre :
• le code s'effectue losrque l'on saisit une valeur dans la colonne B. Donc l'édition de la dernière ligne n'est pas finie, les colonnes C et D ne sont pas remplies...

• la dernière ligne du code :

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

implique que cet onglet existe sinon ça va planter... On peut soit supprimer la ligne du code soit envisager une vérification avant de le sélectionner.

• Tu me demandes d'entregistrer le nouveau fichier sous le nom de "Juillet2012-Valeur". Mais que se passera-t-il quand tu vas saisir deux fois de suite la même référence.
Le fichier doit-il écraser l'ancien ?
Pourquoi ne pas mettre le nom de la référence dans le fichier ?

• tu ne m'a pas dit où tu voulais enregister le fichier :
Dans le même dossier que ton fichier source ?
Ailleurs ?

J'attends tes réponses pour voir comment on peut envisager une solution à ces différentes problèmes.

 

[esperluette]

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

Pourrais-tu m'insérer la macro dans le fichier excel, je ne sais pas comment insérer le vba dans un autre classeur que le classeur où j'ai créé la macro (je suis désolée j'ai vraiment 0 connaissance là-dessus)
- au niveau du nom de fichier, il n'y aura qu'un seul fichier qui aura pour nom "Juillet2012-Valeur1", donc rien ne sera écraser. Car dans cet exemple, on aura toutes les lignes associées à la valeur 1
- je souhaiterais que ces fichiers créés soient dans le même dossier que le fichier source

Je te remercie vraiment de ton aide, et si tu as des bouquins à me proposer sur l'apprentissage de la VBA je suis preneuse !

Merci

 

[Robert]

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

Bonjour Esperluette, bonjour le forum,

En pièce jointe ton fichier avec le code modifié ci-dessous :

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

Teste-le et tu comprendras mieux mes questions...
Par exemple, tu tapes 18 en colonne A, puis 7406 en colonne B... tu n'as même pas le temps d'éditer la colonne C que la macro a déjà créé un fichier nommé : Juillet2012-7406.xlsx reprenant toutes les lignes contenant 7406 mais la dernière ligne n'est pas complètement remplie.
Maintenant, imagine que tu continues, tu tapes 19 en colonne A, puis à nouveau 7406 en colonne B. La macro va vouloir encore créer un fichier Juillet2012-7406.xlsx mais comme il existe déjà il va y avoir plantage...
Et pour finir... Comment tu vas faire en août ?

Le fichier