Copie conditionelle de feuille dans autre classeur
ath80
Messages postés
208
Date d'inscription
Statut
Membre
Dernière intervention
-
ath80 Messages postés 208 Date d'inscription Statut Membre Dernière intervention -
ath80 Messages postés 208 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
https://www.cjoint.com/?CIewPUQ8GtN
Je rencontre petit problème pour l'établissement d'une macro.
J'ai un fichier nommé "Non RO Vilebrequins 2013". A partir de celui-ci, je voudrais copier une feuille dans un autre classeur situé sur un lien intranet de mon entreprise et ceci suivant la valeur de la cellule W2 du classeur "Non RO Vilebrequins 2013". Sur l'intranet, il y aurait donc un classeur par semaine avec une feuille par jour.
Par exemple, la valeur de W2 est S36 et celle de J2 est Lundi. Je veux que la feuille ouvre le classeur S36, qu'il supprime la feuille lundi et qu'il copie la feuille du fichier en la nommant lundi. J'ai crée un tableau avec les liens des autres fichiers pour ouvrir les classeurs correspondants.
Déjà j'ai réalisé une macro du genre:
Sub Archivage_journée()
Sheets("Calculs").Select
nom_semaine37 = "308141918.pc1fm"
Sheets("Feuille remplissage").Select
Select Case [W2].Value
Case Is = "S36"
Sheets("Feuille remplissage").Select
Select Case [J2].Value
Case Is = "Lundi"
Sheets("Calculs").Select
Range("G39").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("Lundi").Select
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Activate
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Copy Before:=Workbooks(nom_semaine37).Sheets(1)
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Name = "Lundi"
Case Is = "Mardi"
Sheets("Calculs").Select
Range("G39").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("Mardi").Select
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Activate
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Copy After:=Workbooks(nom_semaine37).Sheets(1)
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Name = "Mardi"
Case Is = "Mercredi"
Sheets("Calculs").Select
Range("G39").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("Mercredi").Select
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Activate
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Copy After:=Workbooks(nom_semaine37).Sheets(2)
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Name = "Mercredi"
Case Is = "Jeudi"
Sheets("Calculs").Select
Range("G39").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("Jeudi").Select
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Activate
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Copy After:=Workbooks(nom_semaine37).Sheets(3)
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Name = "Jeudi"
Case Is = "Vendredi"
Sheets("Calculs").Select
Range("G39").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("Vendredi").Select
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Activate
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Copy After:=Workbooks(nom_semaine37).Sheets(4)
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Name = "Vendredi"
End Select
End Select
End Sub
Le problème c'est que je devrais répéter ce code autant qu'il y a de semaines. Y a-t-il une autre solution ?
Mon deuxième problème est le suivant: une fois que la macro a ouvert le classeur de la semaine correspondante, la macro revient sur le classeur Non RO Vilebrequins 2013". Pour copier la feuille "Feuille remplissage" dans l'autre classeur, je dois utiliser
Sheets("Feuille remplissage").Copy Before:=Workbooks(308141918.pc1fm).Sheets(1)
Car une fois ouvert le fichier s'intitule 308141918.pc1fm.
http://imageshack.com/f/mv1cjap
Mais une fois que je change le lien de la macro du tableau en "G39", le "308141918.pc1fm" de la macro reste le même, ce qui est normal. Il faudrait utiliser une variable du genre:
Sheets("Calculs").Select
nom_semaine37 = VALEUR DE LA CELLULE H39 DE LA FEUILLE CALCUL
Sheets("Feuille remplissage").Copy Before:=Workbooks(nom_semaine37).Sheets(1)
Mais je ne sais comment faire.
Quelqu'un peut-il m'aider ?
Cordialement.
https://www.cjoint.com/?CIewPUQ8GtN
Je rencontre petit problème pour l'établissement d'une macro.
J'ai un fichier nommé "Non RO Vilebrequins 2013". A partir de celui-ci, je voudrais copier une feuille dans un autre classeur situé sur un lien intranet de mon entreprise et ceci suivant la valeur de la cellule W2 du classeur "Non RO Vilebrequins 2013". Sur l'intranet, il y aurait donc un classeur par semaine avec une feuille par jour.
Par exemple, la valeur de W2 est S36 et celle de J2 est Lundi. Je veux que la feuille ouvre le classeur S36, qu'il supprime la feuille lundi et qu'il copie la feuille du fichier en la nommant lundi. J'ai crée un tableau avec les liens des autres fichiers pour ouvrir les classeurs correspondants.
Déjà j'ai réalisé une macro du genre:
Sub Archivage_journée()
Sheets("Calculs").Select
nom_semaine37 = "308141918.pc1fm"
Sheets("Feuille remplissage").Select
Select Case [W2].Value
Case Is = "S36"
Sheets("Feuille remplissage").Select
Select Case [J2].Value
Case Is = "Lundi"
Sheets("Calculs").Select
Range("G39").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("Lundi").Select
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Activate
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Copy Before:=Workbooks(nom_semaine37).Sheets(1)
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Name = "Lundi"
Case Is = "Mardi"
Sheets("Calculs").Select
Range("G39").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("Mardi").Select
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Activate
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Copy After:=Workbooks(nom_semaine37).Sheets(1)
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Name = "Mardi"
Case Is = "Mercredi"
Sheets("Calculs").Select
Range("G39").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("Mercredi").Select
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Activate
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Copy After:=Workbooks(nom_semaine37).Sheets(2)
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Name = "Mercredi"
Case Is = "Jeudi"
Sheets("Calculs").Select
Range("G39").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("Jeudi").Select
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Activate
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Copy After:=Workbooks(nom_semaine37).Sheets(3)
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Name = "Jeudi"
Case Is = "Vendredi"
Sheets("Calculs").Select
Range("G39").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets("Vendredi").Select
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Activate
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Copy After:=Workbooks(nom_semaine37).Sheets(4)
Sheets("Feuille remplissage").Select
Sheets("Feuille remplissage").Name = "Vendredi"
End Select
End Select
End Sub
Le problème c'est que je devrais répéter ce code autant qu'il y a de semaines. Y a-t-il une autre solution ?
Mon deuxième problème est le suivant: une fois que la macro a ouvert le classeur de la semaine correspondante, la macro revient sur le classeur Non RO Vilebrequins 2013". Pour copier la feuille "Feuille remplissage" dans l'autre classeur, je dois utiliser
Sheets("Feuille remplissage").Copy Before:=Workbooks(308141918.pc1fm).Sheets(1)
Car une fois ouvert le fichier s'intitule 308141918.pc1fm.
http://imageshack.com/f/mv1cjap
Mais une fois que je change le lien de la macro du tableau en "G39", le "308141918.pc1fm" de la macro reste le même, ce qui est normal. Il faudrait utiliser une variable du genre:
Sheets("Calculs").Select
nom_semaine37 = VALEUR DE LA CELLULE H39 DE LA FEUILLE CALCUL
Sheets("Feuille remplissage").Copy Before:=Workbooks(nom_semaine37).Sheets(1)
Mais je ne sais comment faire.
Quelqu'un peut-il m'aider ?
Cordialement.
A voir également:
- Copie conditionelle de feuille dans autre classeur
- Copie cachée - Guide
- Super copie - Télécharger - Gestion de fichiers
- Copie écran samsung - Guide
- Bruler feuille de laurier - Guide
- Feuille de pointage excel - Télécharger - Tableur
3 réponses
Bonjour,
Avant d'attaquer ton projet je me suis permis dans un premier temps d'aléger et surtout d'automatiser ta macro Ci dessus :
remplace ta macro par le code ci-dessous et vois si t'obtiens le même résultat qu'avec l'ancienne macro.
Public Const Sht1 = "Feuille remplissage"
Public Const Sht2 = "Calculs"
Sub Archivage_journée()
Dim TBL_jour As Variant, REF_Sem As Variant, IDT_Sem As Variant
Dim Nom_Fich_Sem As Variant, TBL_Nom As Variant, SHT_Jour As Variant
Dim i As Byte, Nb_Lgn As Long, Lien_H As Long
TBL_jour = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi")
Nb_Lgn = Sheets(Sht2).Cells(Rows.Count, 6).End(xlUp).Row
For i = 3 To Nb_Lgn
REF_Sem = Sheets(Sht2).Cells(i, 6)
IDT_Sem = Sheets(Sht1).Range("J2").Value
If REF_Sem = IDT_Sem Then
Lien_H = i
Nom_Fich_Sem = Sheets(Sht2).Cells(i, 8)
End If
Next i
Sheets(Sht1).Select
For i = 1 To 5
TBL_Nom = TBL_jour(i)
SHT_Jour = [J2].Value
If TBL_Nom = SHT_Jour Then
Sheets(Sht2).Select
Sheets(Sht2).Range("G" & Lien_H).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets(TBL_Nom).Select
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Activate
Sheets(Sht1).Select
Sheets(Sht1).Copy Before:=Workbooks(Nom_Fich_Sem).Sheets(1)
Sheets(Sht1).Select
Sheets(Sht1).Name = TBL_Nom
End If
Next i
End Sub
Les 2 Public Constante qui sont en dehors de la Macro c'est normal.
J'ai mis dans 2 constantes public le nom de tes 2 feuilles
comme ça dans ta macro tu n'as plus qu'a utiliser Sht1 ou Sht2
Pourquoi avoir fait ça ? Tout simplement parce que si tu change le nom de la feuille tu devras changer le nom uniquement dans Public Const et ça se répercutera sur toutes tes macros.
Contrôle déjà si cette macro fonctionne et on verra pour le reste après
Si t'as des question sur la fonctionnalité d'une partie du code n'hésites pas.
PS : sur ton fichier il faut mettre S37 ou S38 et non S36 si tu veux que ça fonctionne.
Avant d'attaquer ton projet je me suis permis dans un premier temps d'aléger et surtout d'automatiser ta macro Ci dessus :
remplace ta macro par le code ci-dessous et vois si t'obtiens le même résultat qu'avec l'ancienne macro.
Public Const Sht1 = "Feuille remplissage"
Public Const Sht2 = "Calculs"
Sub Archivage_journée()
Dim TBL_jour As Variant, REF_Sem As Variant, IDT_Sem As Variant
Dim Nom_Fich_Sem As Variant, TBL_Nom As Variant, SHT_Jour As Variant
Dim i As Byte, Nb_Lgn As Long, Lien_H As Long
TBL_jour = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi")
Nb_Lgn = Sheets(Sht2).Cells(Rows.Count, 6).End(xlUp).Row
For i = 3 To Nb_Lgn
REF_Sem = Sheets(Sht2).Cells(i, 6)
IDT_Sem = Sheets(Sht1).Range("J2").Value
If REF_Sem = IDT_Sem Then
Lien_H = i
Nom_Fich_Sem = Sheets(Sht2).Cells(i, 8)
End If
Next i
Sheets(Sht1).Select
For i = 1 To 5
TBL_Nom = TBL_jour(i)
SHT_Jour = [J2].Value
If TBL_Nom = SHT_Jour Then
Sheets(Sht2).Select
Sheets(Sht2).Range("G" & Lien_H).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Sheets(TBL_Nom).Select
ActiveWindow.SelectedSheets.Delete
ThisWorkbook.Activate
Sheets(Sht1).Select
Sheets(Sht1).Copy Before:=Workbooks(Nom_Fich_Sem).Sheets(1)
Sheets(Sht1).Select
Sheets(Sht1).Name = TBL_Nom
End If
Next i
End Sub
Les 2 Public Constante qui sont en dehors de la Macro c'est normal.
J'ai mis dans 2 constantes public le nom de tes 2 feuilles
comme ça dans ta macro tu n'as plus qu'a utiliser Sht1 ou Sht2
Pourquoi avoir fait ça ? Tout simplement parce que si tu change le nom de la feuille tu devras changer le nom uniquement dans Public Const et ça se répercutera sur toutes tes macros.
Contrôle déjà si cette macro fonctionne et on verra pour le reste après
Si t'as des question sur la fonctionnalité d'une partie du code n'hésites pas.
PS : sur ton fichier il faut mettre S37 ou S38 et non S36 si tu veux que ça fonctionne.
Bonjour
pour t'éviter de répéter la macro 53 fois, tu peux utiliser une macro paramétrée
par ex:
deviendrait
d'ailleurs tu allègerais ton code en paramétrant également le select case sur le mème proncipe
non testé et beaucoup de trucs que je n'ai pas compris dans ce que tu veux faire: ce que je te propose est un principe
......
Michel
pour t'éviter de répéter la macro 53 fois, tu peux utiliser une macro paramétrée
par ex:
Sub Archivage_journée() Sheets("Calculs").Select"30 nom_semaine37 = "8141918.pc1fm"
deviendrait
Sub semaine37 "308141918.pc1fm" '-------- Sub Archivage_journée(nom_semaine) Sheets("Feuille remplissage").....
d'ailleurs tu allègerais ton code en paramétrant également le select case sur le mème proncipe
sub transfert(journee,nom_semaine) Sheets("Calculs").Range("G39").Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True Sheets("Vendredi").ActiveWindow.SelectedSheets.Delete With ThisWorkbook.Sheets("Feuille remplissage") .Copy After:=Workbooks(nom_semaine).Sheets(4) .Name = journee end with '------ sub copier transfert "Vendredi" "8141918.pc1fm" end sub
non testé et beaucoup de trucs que je n'ai pas compris dans ce que tu veux faire: ce que je te propose est un principe
......
Michel
Bonjour,
Déjà désolé pour la réponse tardive, je me suis absenté un petit moment.
WeaponEDGE je voudrais que l'action soit réalisée au clic sur le bouton rouge. Existe-il une méthode pour affecter ton code à forme car je n'y arrive pas ou alors faut-il le modifier de la sorte:
Public Const Sht1 = "Feuille remplissage"
Public Const Sht2 = "Calculs"
devient:
Sub Archivage_journée()
Sht1 = "Feuille remplissage"
Sht2 = "Calculs"
Ça m'affichait une erreur quand j'ai ajouté le sub (sélection en jaune).
http://img62.imageshack.us/img62/1386/8p3l.jpg
Ce que j'ai sélectionné représente ce que j'ai modifié. Par contre ce qui est sélectionné en jaune empêche le fonctionnement de la macro.
michel_m je ne comprends pourquoi mettre:
Sub semaine37 "308141918.pc1fm"
'--------
Sub Archivage_journée(nom_semaine)
Sheets("Feuille remplissage").....
Ce que je veux, c'est en fonction de la valeur de la semaine, ça ouvre le classeur de la semaine correspondante (lien du fichier S38 par ex), copie la feuille et la renomme en la valeur de la journée (si la valeur de la cellule J2 est lundi, la feuille copiée sera renommée en "Lundi").
Désolé mais je n'y connais pas vraiment en macro.
Merci d'avance.
Déjà désolé pour la réponse tardive, je me suis absenté un petit moment.
WeaponEDGE je voudrais que l'action soit réalisée au clic sur le bouton rouge. Existe-il une méthode pour affecter ton code à forme car je n'y arrive pas ou alors faut-il le modifier de la sorte:
Public Const Sht1 = "Feuille remplissage"
Public Const Sht2 = "Calculs"
devient:
Sub Archivage_journée()
Sht1 = "Feuille remplissage"
Sht2 = "Calculs"
Ça m'affichait une erreur quand j'ai ajouté le sub (sélection en jaune).
http://img62.imageshack.us/img62/1386/8p3l.jpg
Ce que j'ai sélectionné représente ce que j'ai modifié. Par contre ce qui est sélectionné en jaune empêche le fonctionnement de la macro.
michel_m je ne comprends pourquoi mettre:
Sub semaine37 "308141918.pc1fm"
'--------
Sub Archivage_journée(nom_semaine)
Sheets("Feuille remplissage").....
Ce que je veux, c'est en fonction de la valeur de la semaine, ça ouvre le classeur de la semaine correspondante (lien du fichier S38 par ex), copie la feuille et la renomme en la valeur de la journée (si la valeur de la cellule J2 est lundi, la feuille copiée sera renommée en "Lundi").
Désolé mais je n'y connais pas vraiment en macro.
Merci d'avance.