Discussion :

[Lily31]

Bonjour,
je suis à la recherche d'une solution qui m'évite de copier/coller mon code des dizaines de fois...
J'ai créée une macro (qui fonctionne) qui permet d'ouvrir un classeur "1", de faire un copier de certaines lignes du classeur "1" et un coller dans un classeur de référence puis de fermer le classeur "1".
Je voudrais que ma macro fasse cette même opération sur plusieurs classeurs et toujours en copiant dans le même classeur de référence.
Pour l'instant j'ai prévu de copier/coller mon code plusieurs fois dans la macro et de remplacer le nom du classeur mais existe-t-il un moyen de faire une boucle (ou autre chose) pour n'avoir qu'une seule fois le code et lui dire de passer en revue tous les classeurs?
J'ai vu que c'était faisable pour toutes les feuilles d'un même classeur mais je n'ai pas trouvé de réponse sur plusieurs classeurs.
Dites moi s'il vous faut plus d'informations.
Merci d'avance.
Lily

[Gado2600]

Bonjour,

Si je comprend bien, tu exécutes ton code à partir de chacun de tes classeurs pour aller dans un seul et unique classeur pour tous, non ?

Pourquoi ne pas faire dans le sens inverse ?
C'est-à-dire, avoir ton code dans le classeur de destination et ouvrir tes classeurs sources pour importer les données.

En gros, plutôt que de faire de l'exportation, fais de l'importation.

Cordialement,

[Lily31]

non j'ai bien ma macro dans un seul fichier (celui dans lequel je récupère les données) et elle commande l'ouverture/récupération de données/fermeture de chaque classeur.
Aujourd'hui j'ai le code (ci-dessous) pour un classeur (classeur1) et je voudrais le répéter sur le classeur 2, 3, etc.
Dans l'idée je rajouterai des variables dans la partie Liste des builders et je voudrais m'en servir dans une boucle mais je ne sais pas comment le faire/si c'est faisable/si il y mieux...
Merci d'avance pour votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
'Déclaration de variables
    'Fichier de compilation
        Dim Tool As String 'Nom du fichier
            Tool = "tool.xlsm"
        Dim Backlog As String 'Feuille de compilation des backlog HoV
            Backlog = "BacklogHoV"
        Dim EmptyCell As String 'A partir de quelle cellule on cherche la première non vide en partant du bas
            EmptyCell = "A200"
        Dim NotUpdated As String 'Feuille des builders non mis à jour
            NotUpdated = "NotUpdated"
    'Structure des builders
        Dim Folder As String 'Dossier de stockage des builders
            Folder = "C:\Users\NG4CA52\Desktop\test\" 
         Dim Command As String 'Feuille contenant la semaine en cours
            Command = "Command"
        Dim BuilderWeek As String 'Cellule contenant la semaine en cours
            BuilderWeek = "B4"
        Dim Datas As String 'Feuille contenant le numéro de MSN
            Datas = "Datas"
        Dim MSN As String 'Cellule contenant le numéro de MSN
            MSN = "A2"
        Dim Status As String 'Feuille contenant la liste des backlog
            Status = "Status"
    'Liste des builders
           Dim classeur1 As String
           classeur 1 = "classeur1.xlsm"
    'Variables nécessaires à la macro
            Dim BacklogRow As String 'ligne contenant le mot Backlog
            Dim NextRow As String 'ligne juste après la liste des backlog
            Dim CurrentWeek As String 'semaine en cours
                CurrentWeek = InputBox("Put Current Week as YY CW XX", "TOP50 Week", "15CWxx")
'Ouvrir le builder
        Workbooks.Open (Folder & classeur1), ReadOnly:=True
    'Tester si c'est la bonne semaine
        Sheets(Command).Select
        ActiveSheet.Range(BuilderWeek).Select
If Selection = CurrentWeek Then
    'Récupérer le numéro de MSN
        Sheets(Datas).Select
        ActiveSheet.Range(MSN).Select
        Selection.Copy
        Windows(Tool).Activate
        Sheets(Backlog).Select
        ActiveSheet.Range(EmptyCell).End(xlUp).Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    'Rechercher la ligne avec "Backlog"
        Windows(classeur1).Activate
        Sheets(Status).Select
        BacklogRow = ActiveSheet.Cells.Find(What:="backlog", LookAt:=xlPart).Row
    'Rechercher la ligne avec "Next 4 weeks forecast"
        NextRow = ActiveSheet.Cells.Find(What:="4 weeks", LookAt:=xlPart).Row
    'Sélectionner les lignes entre les deux - copier
        ActiveSheet.Rows(BacklogRow + 1 & ":" & NextRow - 1).Select
        Selection.Copy
    'Coller dans un classeur de compilation à la suite de la dernière ligne écrite
        Windows(Tool).Activate
        Sheets(Backlog).Select
        ActiveSheet.Range(EmptyCell).End(xlUp).Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
    'Récupérer le numéro de MSN
        Sheets(Datas).Select
        ActiveSheet.Range(MSN).Select
        Selection.Copy
        Windows(Tool).Activate
        Sheets(NotUpdated).Select
        ActiveSheet.Range(EmptyCell).End(xlUp).Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
    'Fermer le builder et revenir au classeur de compilation
        Windows(classeur1).Activate
        Application.CutCopyMode = False
        ActiveWorkbook.Close Savechanges:=False
        Windows(Tool).Activate
        Sheets(Backlog).Select
        ActiveSheet.Range("A1").Select

[vinc_bilb]

Bonjour,

Oui, c'est possible et même plus que recommandé, il suffit en bref de rajouté l'objet workbook (positionné par défaut comme pour les feuilles) dans vos codes (et éventuellement de le passer en argument)

- ThisWOrkbook: Classeur contenant le code VBA
- ActiveWorkBook: Classeur Actif
- WOrkBook("WbkNom")

Ca marche comme les feuilles, au niveau au dessus....

Exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 'On parcourt tous les workbooks ouverts et on sort leur nom + hyperling sur la fenêtre de debug
For Each Wbk In Workbooks
   Debug.Print Wbk.Name, Wbk.FullName
Next
 
 
 
Function GetLastDate(Wbk As Workbook, WshColl As Collection, RefDateAddr As String, PromptUser As Boolean) As Date
' Parse all the sheets from the collection ...
 
    Dim WshCollInd As Integer
    Dim RefDate As Date, WsRefDate As Date, RngVal As Variant
 
    On Error GoTo Err_GetLastDate
 
    If IsMissing(Wbk) Then Set Wbk = ActiveWorkbook
 
    For WshCollInd = 1 To WshColl.Count

[Lily31]

Merci pour ces informations

Par contre je suis totalement novice et je sais pas trop comment implémenter cette solution dans mon code :-(

[vinc_bilb]

Rebonjour,

Vous pourriez fournir un exemple? Il y a plein de choses qui marchent mais très lentes dans votre code, surtout sur les copy/paste et les accès aux Workbooks / Worksheets avec beaucoup de trop de Select sur les range qui ne servent à rien
Vous pourriez définir un range dans votre classeur qui contient le code, contenant les différents paramètres (Wbk name, Wsh name, range, ....) des éléments à récupérer et à copier et parcourir ce range là pour piquer les paramètres ....

A voir