Macro réunissant fonctions recherche et extraction

Bonjour,

Gros problème et honnêtement espérer trouver une solution ce n'est pas gagné.

D'abord avoir une macro qui réunirait à la fois une fonction recherche d'un fichier et l'extraction de données. Bien entendu, extraction si le fichier est trouvé.

Voici plus en détail : j'ai deux fichiers (plan d'action SMQ, rapport audit qui est enregistré sous la forme d'un numéro). Dans le plan d'action SMQ, j'ai inséré un bouton ouvrant une fenêtre (userform) afin de saisir le nom du fichier recherché. Le fichier recherché est obligatoirement enregistré sous le chemin d'accès : G:\S-ISO\A-Audits.

Je voudrai en cliquant sur ok de cette fenêtre de recherche :

qu'il m'ouvre le fichier recherché ou

qu'il m'affiche un message en disant qu'il n'a rien trouvé.

Si il ouvre le fichier, la macro devra extraire des données comme suit :

extraire la donnée présente dans la cellule H8 du fichier ouvert (rapport audit) onglet 'Plan d'audit" et la coller dans le plan d'action SMQ colonne N de la dernière ligne vide,

- la macro devra vérifier l'onglet ConstatsISO du fichier ouvert (rapport d'audit) : si A8 de cet onglet de complété alors extraire les données A8 +B8+C8+D8+E8 et les copier dans le plan d'action SMQ de la dernière ligne vide dans les colonnes respectives I+P+H+Q+R. Procéder de même avec la ligne suivante du fichier ouvert même onglet si complétée.

- Si ligne suivante vide, la macro devra aller à l'onglet ConstatsISO22000 du fichier ouvert (rapport d’audit) : si A8 de cet onglet.... (même opération que l'onglet précédent). Procéder de même avec la ligne suivante du ficher ouvert même onglet si complétée.

- Si ligne suivante vide, la macro devra aller à l'onglet Constats IFS du fichier ouvert : vérifier si, à partir de C6, une cellule de la colonne C des données sont présentes. Si complétée prendre la valeur dans la cellule colonne C ainsi que celle présente dans les cellules adjacentes de la même ligne des colonnes D+E+B+F. Les copier dans la dernière ligne du fichier Plan d'action SMQ dans les cellules respectives des colonnes I+P+H+Q+R. Procéder de même avec la ligne suivante du fichier ouvert même onglet si complétée.

- Si ligne suivante vide, la macro devra vérifier l'onglet Constats BRC du fichier ouvert : vérifier si, à partir de C6, une cellule de la colonne C des données sont présentes. Si complétée prendre la valeur dans la cellule colonne C ainsi que celle présente dans les cellules adjacentes de la même ligne des colonnes D+E+B+F. Les copier dans la dernière ligne du fichier Plan d'action SMQ dans les cellules respectives des colonnes I+P+H+Q+R. Procéder de même avec la ligne suivante du fichier ouvert même onglet si complété.

Fermeture du fichier recherché.

Ouf voilà pour mon problème et surtout merci à ceux qui liront et/ou m’aideront à résoudre cette énigme.

78rapport-audit.zip (21.84 Ko)

Bonsoir,

Trop de lecture !

peux-tu résumer en 3 lignes et expliquer le problème sur une feuille

Amicalement

Claude

Bonjour Dubois,

Merci pour ta réponse.

En fait, Je voudrai qu'avec une macro je puisse rechercher un fichier sur un chemin d'accès bien précis. Si la macro trouve ce fichier, qu'elle l'ouvre et qu'elle extrait des données issues de plusieurs onglets.

Je joins une page word regroupant le déroulement des opérations.

Cordialement.

Bonjour,

J'ai trouvé ce code pour la recherche mon problème c'est qu'il n'ouvre pas le fichier qui se trouve sous le chemin d'accès désigné dans la macro. Le fichier recherché est bien présent.

Si vous avez une réponse à ce problème je pourrai éventuellement travailler sur la deuxième phase l'extraction.

Private Sub CommandButton1_Click()
Dim Wb As Workbook
Feuil1.Select 'Feuil1(nom de gauche en projet)
chemin = "G:\S - ISO\A - Audits\"
fichier = TextBox1.Text
On Error Resume Next
Set Wb = GetObject(chemin & fichier)
If Err <> 0 Then MsgBox "Fichier Absent": Exit Sub

-- 17 Aoû 2010, 12:36 --

Erreur corrigé.

fichier = TextBox1.Text & ".xls"

Je poursuis pour l'extraction.

-- 17 Aoû 2010, 14:32 --

Voici la macro pour rechercher et extraire :

Private Sub CommandButton1_Click()
Dim Wb As Workbook
Feuil1.Select  'Feuil1(nom de gauche en projet)
chemin = "G:\S - ISO\A - Audits\"
fichier = TextBox1.Text & ".xls"
On Error Resume Next
Set Wb = GetObject(chemin & fichier)
If Err <> 0 Then MsgBox "Fichier Absent": Exit Sub
lig = [N65536].End(3).Row + 1
Range("N" & lig).Value = Wb.Sheets(1).[H8].Value
With Wb.Sheets("ConstatsISO")
For k = 8 To .[A65536].End(3).Row
If .Range("A" & k) <> "" Then
lig = [I65536].End(3).Row + 1
Range("I" & lig).Value = .Range("A" & k).Value
Range("P" & lig).Value = .Range("B" & k).Value
Range("H" & lig).Value = .Range("C" & k).Value
Range("Q" & lig).Value = .Range("D" & k).Value
Range("R" & lig).Value = .Range("E" & k).Value
End If
Next
End With

With Wb.Sheets("ConstatsISO22000")
For k = 8 To .[A65536].End(3).Row
If .Range("A" & k) <> "" Then
lig = [I65536].End(3).Row + 1
Range("I" & lig).Value = .Range("A" & k).Value
Range("P" & lig).Value = .Range("B" & k).Value
Range("H" & lig).Value = .Range("C" & k).Value
Range("Q" & lig).Value = .Range("D" & k).Value
Range("R" & lig).Value = .Range("E" & k).Value
End If
Next
End With

With Wb.Sheets("ConstatsIFS")
For k = 6 To .[C65536].End(3).Row
If .Range("C" & k) <> "" Then
lig = [I65536].End(3).Row + 1
Range("I" & lig).Value = .Range("C" & k).Value
Range("P" & lig).Value = .Range("D" & k).Value
Range("H" & lig).Value = .Range("E" & k).Value
Range("Q" & lig).Value = .Range("B" & k).Value
Range("R" & lig).Value = .Range("F" & k).Value
End If
Next
End With

With Wb.Sheets("ConstatsBRC")
For k = 6 To .[C65536].End(3).Row
If .Range("C" & k) <> "" Then
lig = [I65536].End(3).Row + 1
Range("I" & lig).Value = .Range("C" & k).Value
Range("P" & lig).Value = .Range("D" & k).Value
Range("H" & lig).Value = .Range("E" & k).Value
Range("Q" & lig).Value = .Range("B" & k).Value
Range("R" & lig).Value = .Range("F" & k).Value
End If
Next
End With
Wb.Close
End Sub

Avec ce code j'ai un souci avec l'extraction d'une valeur présente dans le fichier trouvé.

Concrètement : Le plan d'action SMQ recoit les données.

Le second fichier recherché et dont les données sont extraites, il faut que la valeur présente dans la cellule H8 de l'onglet "Plan d'audit" de ce second fichier soit intégré dans le plan d'action SMQ colonne N mais cette valeur devra être recopiée autant de fois qu'il y a de données présentes dans les onglets Constats vérifiés par la macro.

Là je sais pas faire

-- 17 Aoû 2010, 16:56 --

Code corrigé :

Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
Rechercher des sujets similaires à "macro reunissant fonctions recherche extraction"