Macro réunissant fonctions recherche et extraction

T

thomasdu40

XLDnaute Occasionnel
Bonjour,

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. Est-ce possible ?

J'ai effectué pas mal de recherche et honnêtement je coince.:(

Pour explication, je joins une page regroupant le déroulement des opérations.

Merci.
 

Pièces jointes

  • Classeur1.xls
    22 KB · Affichages: 53
  • Classeur1.xls
    22 KB · Affichages: 55
  • Classeur1.xls
    22 KB · Affichages: 52
Trier par date Trier par votes
youky(BJ)

youky(BJ)

XLDnaute Barbatruc
Re : Macro réunissant fonctions recherche et extraction

Bonjour thomasdu40,
J'ai fais seulement un début de macro, comme je ne peux rien tester je t'en laisse le soin
Je me suis arrêté et vais pas voir en constatsISO22000.
Donc à tester
Bruno
Code: 
Sub test()
Dim Wb As Workbook
Sheets(1).Select 'revoir si c'est la page 1 qui recois les données
On Error Resume Next
Set Wb = GetObject("G:\S-ISO\A-Audits\NomFichier.xls") 'revoir nomfichier
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
Wb.Close
End Sub
 
Vote positif 0 Vote négatif
T

thomasdu40

XLDnaute Occasionnel
Re : Macro réunissant fonctions recherche et extraction

Bonjour Youky et merci pour ton aide.

Apparemment dans la macro, la recherche d'un fichier se fait en inscrivant le nom directement dans la macro. Chose que je ne veux pas. Là je sais pas si c'est du domaine du possible.

Moi je voudrai que dès que j'ouvre la fenêtre de recherche, que je saisisse le nom du fichier et que le macro me recherche ce fichier dans le chemin voulu.

Je joins le fichier où on recherchera le fichier et qui recevra les données.

Merci.
 

Pièces jointes

  • Copie de plan d'action SMQ 4.xls
    29.5 KB · Affichages: 44
Vote positif 0 Vote négatif
youky(BJ)

youky(BJ)

XLDnaute Barbatruc
Re : Macro réunissant fonctions recherche et extraction

Thomas Voici,
Je te renvoi le fichier corrigé avec cette macro
Bruno
Code: 
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
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
Wb.Close
End Sub
 

Pièces jointes

  • ActionThomas1.xls
    34 KB · Affichages: 55
  • ActionThomas1.xls
    34 KB · Affichages: 54
  • ActionThomas1.xls
    34 KB · Affichages: 56
Dernière édition:
Vote positif 0 Vote négatif
youky(BJ)

youky(BJ)

XLDnaute Barbatruc
Re : Macro réunissant fonctions recherche et extraction

Voici la macro entière
Passe en revu dans la macro les noms des onglets car j'ai remarqué avec ou sans espaces
Les noms des onglets doivent bien être orthographiés.
Bruno
Code: 
Sub test()
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
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
 
Dernière édition:
Vote positif 0 Vote négatif
T

thomasdu40

XLDnaute Occasionnel
Re : Macro réunissant fonctions recherche et extraction

La recherche peut se faire sur un fichier non texte c'est à dire enregistré sour la forme suivante : 03-2010 ?

Car j'ai vu la ligne "fichier = TextBox1.Text" dans la macro qui apparemment recherche un fichier enregistré sous la forme d'un texte.

En tout cas la macro fonctionne à première vue. C'est super et je te remercie de ta collaboration mais surtout pour ta réactivité et tes connaissances dans ce domaine.:D
 
Vote positif 0 Vote négatif
T

thomasdu40

XLDnaute Occasionnel
Re : Macro réunissant fonctions recherche et extraction

Le seul hic c'est qu'il ne m'extrait pas le numéro du rapport qui se trouve dans le fichier trouvé à l'onglet "plan d'audit" pour le coller dans le plan d'action SMQ colonne N de la dernière ligne vide.

Voici la ligne :
Code: 
Range("N" & lig).Value = Wb.Sheets(1).[H8].Value
 
Vote positif 0 Vote négatif
youky(BJ)

youky(BJ)

XLDnaute Barbatruc
Re : Macro réunissant fonctions recherche et extraction

re,
remplace
Range("N" & lig).Value = Wb.Sheets(1).[H8].Value
par
Range("N" & lig).Value = Wb.Sheets("plan d'action SMQ").[H8].Value
si ce nom d'onglet est bien le bon car je n'arrive pas à bien saisir le nom des onglets.
Ps :
dans ma dernière macro remplace
Feuil1.select
par
Sheets("nom de l'onglet qui reçoit les données).select
 
Vote positif 0 Vote négatif
T

thomasdu40

XLDnaute Occasionnel
Re : Macro réunissant fonctions recherche et extraction

Re,

Non cela ne marche pas. J'ai remis "Feuil1.Select" par contre le code suivant
Code: 
Range("N" & lig).Value = Wb.Sheets("plan d'action SMQ").[H8].Value
ne fonctionne pas.

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.

Dur dur non ?
 
Dernière édition:
Vote positif 0 Vote négatif
youky(BJ)

youky(BJ)

XLDnaute Barbatruc
Re : Macro réunissant fonctions recherche et extraction

Re, suite
La macro modifiée dans ce fichier
Bruno
 

Pièces jointes

  • ActionThomas1.xls
    35.5 KB · Affichages: 40
  • ActionThomas1.xls
    35.5 KB · Affichages: 41
  • ActionThomas1.xls
    35.5 KB · Affichages: 39
Vote positif 0 Vote négatif
T

thomasdu40

XLDnaute Occasionnel
Re : Macro réunissant fonctions recherche et extraction

Merci à toi Youky.

Même si il ne recopie pas le contenu de la cellule H8 dans chacune des lignes du Plan d'action SMQ sauf la première, je considère que le gros du travail est fait.

Je vais essayé de trouver la solution moi-même.

Je clôture ce sujet.

Encore merci pour ton aide.
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Résolu(e)
XL 2013 Problème de checkboxes et lecteurs partagés
Réponses
1
Affichages
651
Ptrs32
P
L
  • Question
XL 2016 aide pour une macro qui filtre et range suivant des colonnes
Réponses
11
Affichages
1 K
laurent54000
L
M
  • Question
Word Macro Word simplifier macro modifiant recherche mots clés et modification format
Réponses
2
Affichages
1 K
MANTE
M
M
  • Question
XL 2019 Configuration de bouton de formulaire sous condition
Réponses
2
Affichages
801
Monhtc
M
A
  • Question
Macro de recherche et extraction d'informations à travers plusieurs fichiers
Réponses
7
Affichages
4 K
vgendron
vgendron
B
  • Question
XL 2010 Demande de formule complexe avec recherche de données dans fichier texte pour tableau et graphique
Réponses
6
Affichages
1 K
Benjam
B
A
  • Question
VBA - Pb Macro - Sortir d'une boucle If
Réponses
3
Affichages
6 K
Hervé
Hervé
D
  • Question
macro recherche + copie/colle dans une autre feuille et suprime
Réponses
2
Affichages
536
dreamy
D
B
  • Question
Problème extraction de données via une macro : Guillemets en double !
Réponses
1
Affichages
737
Yaloo
Y
P
  • Question
Macro - Recherche et sélection de fichier
Réponses
0
Affichages
768
panpipes
P

Membres actuellement en ligne

12 membres et 169 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 103
Messages
2 085 312
Membres
102 860
dernier inscrit
fredo67