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   -
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.



A voir également:

3 réponses

WeaponEDGE
 
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.
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
Bonjour
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
0
ath80 Messages postés 208 Date d'inscription   Statut Membre Dernière intervention   9
 
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.
0