Macro recherche par lignes

Bonjour à tous ,

J'ai besoin de votre aide dans une macro que je n'ai pas su comment la développer.

Alors j'ai des classeurs de n équipes et un autre classeur où les décisions de chaque équipe vont être coller durant ( 12 mois). Pour faciliter l'explication, je vais prendre par exemple

J'ai n classeur n= nombre équipes

Et jai un fichier decision qui contient x onglets (x=nombre de périodes)

Alors par exemple : si n=3 c-à-d équipe 3, du coup la macro va ouvrir le classeur « equipe3 »

Puis faire copier les données enregistrées dans la période 1 et les coller dans fichier deision dans l’onglet 1.

Le problème ce pose au niveau du classeur " fichier décisions " car les décisions de chaque équipe sera transmise selon le nombre de la ligne où elle a été écrite et non pas selon le libellé de la décision .

Par exemple : . Dans la cellule B2 du classeur fiche de décisions, il a le chiffre 1 qui va apparaitre puisque cette cellule fait référence à la ligne 3 du classeur equipe 1

Merci d'avance de votre réponse

1equipe-3.xlsx (15.48 Ko)
2equipe-2.xlsx (15.48 Ko)
4equipe-1.xlsx (16.21 Ko)

Bonjour Isabelle ! Salut le Fofo !

Tu trouveras ci-joint ton fichier modifié avec le code ci-dessous :

Function FileOpen(File As String) As Boolean
Dim i As Long
For i = 1 To Workbooks.Count
    If Mid(Workbooks(i).Name, 1, InStr(1, Workbooks(i).Name, ".") - 1) = File Then FileOpen = True
Next
End Function
Sub Export()
Dim c, p, a, b As Range, wsh As Worksheet, wb As Workbook
Set wsh = ThisWorkbook.Worksheets(ActiveSheet.Name)
Set p = wsh.Range("C2:E" & wsh.Range("B" & Rows.Count).End(xlUp).Row)
For Each c In p
    If c.Value = "" Then GoTo NextIteration
    If FileOpen(Cells(1, c.Column)) = True Then Set wb = Workbooks(wsh.Cells(1, c.Column) & ".xlsx")
    'ICI
    If FileOpen(Cells(1, c.Column)) = False Then Set wb = Workbooks.Open("P:\PERSONNEL\Excel\FICHIER TRAME\" & wsh.Cells(1, c.Column) & ".xlsx")
    Set a = wb.Sheets(1).Cells.Find(wsh.Name)
    Set b = wb.Sheets(1).Cells.Find(wsh.Cells(c.Row, 2))
    If a Is Nothing Or b Is Nothing Then c.Interior.Color = 355: GoTo NextIteration
    wb.Sheets(1).Cells(b.Row, a.Column) = c.Value
NextIteration:
wsh.Activate
Next
Set wb = Nothing: Set wsh = Nothing: Set p = Nothing: Set a = Nothing: Set b = Nothing
End Sub

Il faut que tu pense à modifier le chemin vers tes fichiers équipes dans le code (Cf. ICI)

Si tu a besoin d'explication, des questions ou que tu souhaite apporter des modifications, je reste à dispo!

3pour-isabelle.xlsm (22.83 Ko)

Bonjour ,

D'accord , Merci bcpppppppppppppppppppppp de votre réponse

Bonne journée,

Re Bonjour,

J'ai changé le chemin du fichier décision est le code ne marche pas et aucune erreur n'est affichée .

J'ai essayé de comprendre le code afin de le modifier mais en vain vu que je suis débutant

alors j’abuse de votre gentillesse et je vous demande si c'est possible de me le réexpliquer pas à pas .

Merci d'avance de votre réponse,

Re Isabelle,

changé le chemin du fichier décision

C'est le chemin vers tes fichiers Équipes qu'il faut indiquer ! C'est eux que nous allons ouvrir pour mettre les données de ton fichier décision vers les fichiers équipes.

ou alors j'ai compris le problème à l'envers, et ces des fichiers équipes vers le fichier décision qu'il fallait envoyer les données?

J'ai essayé de comprendre le code afin de le modifier mais en vain vu que je suis débutant

alors j’abuse de votre gentillesse et je vous demande si c'est possible de me le réexpliquer pas à pas .

Laisse tomber le vouvoiement °^°

Ci-dessous les explications au pas à pas du code

Sub Export()
'Déclaration des variables
'c as range pour cellule à traiter
'p as range pour plage à traiter
'a as range pour recherche du numéro de colonne où insérer les données du fichier de décision
'b as range pour recherche du numéro de ligne où insérer les données du fichier de décision
'wsh as worksheet pour mon classeur + feuille active du fichier décision
'wb as workbook pour mon classeur équipe ET par défaut ma feuille 1
Dim c, p, a, b As Range, wsh As Worksheet, wb As Workbook
'ma var wsh deviens donc mon classeur décision et la feuille active sur laquelle je suis
'au moment où je lance la macro
Set wsh = ThisWorkbook.Worksheets(ActiveSheet.Name)
'ma var p deviens donc la plage où mes données sont inscrites
'elle commence en cellule C2 et ira jusqu'à la cellule E + dernière ligne non vide de la colonne B
Set p = wsh.Range("C2:E" & wsh.Range("B" & Rows.Count).End(xlUp).Row)
'Je lance le traitement de ma boucle (For) en disant que je veux analyser chaque cellule (c) de ma plage (p)
For Each c In p
    'Si la cellule (c) qui est en train d'être traiter est vide, alors je vais traiter une autre cellule
    If c.Value = "" Then GoTo NextIteration
    'Si la cellule (c) n'est pas vide, alors c'est que j'ai une donnée à rapporter sur un fichier équipe
    'Je veux savoir si mon fichier est déjà ouvert ou non
    'Pour savoir cela, j'utilise une Function
    '
    'Cf explication de la Funtion FileOpen avant de continuer
    '
    'Si ma Function a renvoyé True alors c'est que mon fichier est déjà ouvert
    'En ce cas ma var wb deviens donc le fichier "equipe" .xlsx
    If FileOpen(Cells(1, c.Column)) = True Then Set wb = Workbooks(wsh.Cells(1, c.Column) & ".xlsx")
    'Si ma Function a renvoyé False, alors c'est que mon fichier n'est pas ouvert
    'En ce cas on va ouvrir le fichier en indiquand le chemin + equipe + .xlsx
    'Et ma var wb deviendra alors ce fichier
    If FileOpen(Cells(1, c.Column)) = False Then Set wb = Workbooks.Open("P:\PERSONNEL\Excel\FICHIER TRAME\" & wsh.Cells(1, c.Column) & ".xlsx")
    'Avec la fonction Find, on va chercher à l'intérieur de mon fichier (wb)
    'La colonne correspondante au nom de ma feuille active
    'Dans l'exemple, ce sera Janvier qui serra recherché
    Set a = wb.Sheets(1).Cells.Find(wsh.Name)
    'Avec la fonction Find, on va chercher à l'intérieur de mon fichier (wb)
    'La ligne correspondante au libellé de la cellule (c) qui est en train d'être traité par ma boucle
    'Dans l'exemple, ce sera "a18"
    Set b = wb.Sheets(1).Cells.Find(wsh.Cells(c.Row, 2))
    'Si je n'ai pas trouvé ma ligne ou ma colonne
    'alors je met ma cellule (c) en couleur dans mon classeur décision pour afficher une erreur
    'et je passe à une autre cellule
    If a Is Nothing Or b Is Nothing Then c.Interior.Color = 355: GoTo NextIteration
    'Si j'ai bien trouvé ma ligne et ma colonne
    'alors j'exporte la donnée de la cellule (c) de mon classeur décision
    'vers mon classeur équipe (wb) à la cellule de la ligne (b) et colonne (a) trouvé
    wb.Sheets(1).Cells(b.Row, a.Column) = c.Value
'Permet de passer à une autre cellule
NextIteration:
'Dans tout les cas on reviens vers sur notre classeur décision
wsh.Activate
'On passe ensuite au traitement d'une autre cellule (c) de ma plage (p)
Next
'Notre traitement est terminée, on vide nos var pour liberer de la mémoire
Set wb = Nothing: Set wsh = Nothing: Set p = Nothing: Set a = Nothing: Set b = Nothing
End Sub
'Ma fonction FileOpen attend un argument de type texte (String) que l'on nomme File
'L'argument File prend la valeur de la ligne 1 dans la colonne de la cellule en cours de traitement
'C'est à dire que si la cellule en cours de traitement est la cellule C4 alors la valeur
'de File serra la valeur de ma cellule C1, soit "Équipe 1"
'Et on recherche donc un fichier qui s'appel "Équipe 1" dans tout les fichiers Excel ouvert
Function FileOpen(File As String) As Boolean
'i as long pour boucler sur les fichiers ouvert
Dim i As Long
'On lance ma boucle en disant que je veux analyser tout les fichiers ouverts (de 1 à nbr de fichier ouvert)
For i = 1 To Workbooks.Count
    'Si le fichier ouvert n° i à le même nom que ma varibale File
    'Alors on arrête le traitement de ma Function, et celle-ci renverra True
    'Sinon False
    If Mid(Workbooks(i).Name, 1, InStr(1, Workbooks(i).Name, ".") - 1) = File Then FileOpen = True
Next
End Function

En espérant que sa aide

Sinon hésite pas !

Re bonjour,

Merci de votre réponse alors je pense que je me suis mal exprimé car l'exportation se fait des fichiers equipes vers décision .

Bon bah on verra sa Jeudi si possible, parce que là il y a tout à reprendre

D'accord, merci bcpppp

Rechercher des sujets similaires à "macro recherche lignes"