Recherche d'un fichier et extraction des données

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion henrylandes
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
H

henrylandes

XLDnaute Nouveau
Bonjour,
Gros problème.
J’ai deux fichiers : Tableau bilan questionnaire ET Questionnaire satisfaction

Je voudrai rechercher le questionnaire de satisfaction dans un dossier bien précis et recopier les données de ce fichier dans le Tableau bilan questionnaire. Bien entendu recopier les informations dans la dernière ligne vide. Pour ça j’ai réussi à créer ce code (voir ci-après) mais il ne fonctionne pas puisqu’il me met « fichier absent ».😕

Je joins un fichier word explicatif.

Code: 
Private Sub CommandButton1_Click()
Dim Wb As Workbook
Feuil1.Select  'Feuil1(nom de gauche en projet)
Chemin = "C:\WINDOWS\Web\" 'chemin où se trouve les fichiers'
Fichier = TextBox1.Text & ".xls"
On Error Resume Next
Set Wb = GetObject(Chemin & Fichier)
If Err <> 0 Then MsgBox "Fichier Absent": Exit Sub
With Wb.Sheets("Feuil1") 'Nom de la feuille du questionnaire de satisfaction'
For k = 6 To .[A65536].End(3).Row
If .Range("A" & k) <> "" Then
lig = [I65536].End(3).Row + 1
Range("A" & lig).Value = .TextBox4.Value
Range("B" & lig).Value = .TextBox5.Value
Range("C" & lig).Value = .IIf(.Range("F20" & k).Value = "x", "1", IIf(.Range("G20" & k).Value = "x", "0", IIf(.Range("H20" & k).Value = "x", "-1", "/")))
Range("D" & lig).Value = .IIf(.Range("F21" & k).Value = "x", "1", IIf(.Range("G21" & k).Value = "x", "0", IIf(.Range("H21" & k).Value = "x", "-1", "/")))
Range("D" & lig).Value = .IIf(.Range("F22" & k).Value = "x", "1", IIf(.Range("G22" & k).Value = "x", "0", IIf(.Range("H22" & k).Value = "x", "-1", "/")))
If Range("I20") <> "" Then Res = 1 & Range("I20")
If Range("I21") <> "" Then Res = Res & 2 & Range("I21")
If Range("I22") <> "" Then Res = Res & 3 & Range("I22")
Range("L6") = Res
End If
Next
End With

Wb.Close
End Sub

Merci à vous.
 

Pièces jointes

Trier par date Trier par votes
Re : Recherche d'un fichier et extraction des données

bonjour henrylandes
essaye ce qui suit
pour les test ?????
Private Sub CommandButton1_Click()
Dim Wb As Workbook
Feuil1.Select 'Feuil1(nom de gauche en projet)
Chemin = "C:\WINDOWS\Web\" 'chemin où se trouve les fichiers'
Fichier = "codespostaux.xls" 'TextBox1.Text & ".xls"
'On Error Resume Next
Set Wb = Workbooks.Open(Filename:=Chemin & Fichier)
'If Err <> 0 Then MsgBox "Fichier Absent": Exit Sub
With Wb.Sheets("Feuil1") 'Nom de la feuille du questionnaire de satisfaction'
For k = 6 To .[A65536].End(3).Row
If .Range("A" & k) <> "" Then
lig = [I65536].End(3).Row + 1
Range("A" & lig).Value = .TextBox4.Value
Range("B" & lig).Value = .TextBox5.Value
If .Range("F" & k).Value = "x" Then
Range("C" & lig).Value = 1
Range("D" & lig).Value = 1
ElseIf .Range("G" & k).Value = "x" Then
Range("C" & lig).Value = 0
Range("D" & lig).Value = 0
ElseIf .Range("H" & k).Value = "x" Then
Range("C" & lig).Value = -1
Range("D" & lig).Value = -1
Else
If .Range("F" & k).Value = "" And .Range("G" & k).Value = "" And .Range("H" & k).Value = "" Then
Range("C" & lig).Value = "/"
Range("D" & lig).Value = "/"
End If
End If
If .Range("I" & k) <> "" Then
Range("L" & lig) = .Range("A" & k) & .Range("I" & k)
End If
Next
End With

Wb.Close

End Sub


à bientôt
 
Vote positif 0 Vote négatif
Re : Recherche d'un fichier et extraction des données

bonjour henrylandes
c'est tjrs une aventure un code sans essai
un fichier joint est tjrs mieux
If .Range("A" & k) <> "" Then
lig = [I65536].End(3).Row + 1
Range("A" & lig).Value = .TextBox4.Value
Range("B" & lig).Value = .TextBox5.Value
If .Range("F" & k).Value = "x" Then
ajoute else devant if devient elseif(ligne précédente)
à bientôt
 
Vote positif 0 Vote négatif
Re : Recherche d'un fichier et extraction des données

Re Bebere

Par rapport à ton code j'ai supprimé le nom d'un fichier que tu m'as donné
Code: 
"codespostaux.xls"
puisque je pensais que mettre
Code: 
Fichier = TextBox1.Text & ".xls"
correspondait à ce qu'on saisissait dans le TextBox.

Pour que je sois plus précis j'aurai dû mettre mes deux fichiers en question et ils viennent compléter mon fichier word qui explique comment extraire les données issues du fichier intitulé "Questionnaire satisfaction" vers le fichier intitulé "Tableau bilan questionnaire".

Merci.
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Recherche d'un fichier et extraction des données

Re bonjour à toi.

Et toujours un grand merci pour ton aide.

La cellule L doit être compléter par rapport aux informations issues des cellules du questionnaire de satisfaction comme suit :

L (cellule du TableauBilanQuestionnairesTest) = à I20 (cellule du questionnaire satisfaction) si <>"" et A20 +
I21 si <> "" et A21 + I22 si <>"" et A22 + I23 <>"" et A23 + I24 <>"" et A24 + I25 <>"" et A25 + I26 <>"" et A26 + I27 <>"" et A27 + I28 <>"" et A28 + I29 <>"" et A29.

Les cellules A20 à A29 ne sont prises en compte que si les cellules I20 à I29 contiennent du texte.

En résumé la cellule L du tableua bilan questionnaire doit comporter tout ce qui est saisie dans les cellules I20 à I29 et A20 à A29.

Voici peut être pour éclaircir le code :
Code: 
If Range("I20") <> "" Then Res = 1 & Range("I20")
If Range("I21") <> "" Then Res = Res & 2 & Range("I21")
If Range("I22") <> "" Then Res = Res & 3 & Range("I22")
If Range("I23") <> "" Then Res = Res & 3 & Range("I23")
If Range("I24") <> "" Then Res = Res & 3 & Range("I24")
If Range("I25") <> "" Then Res = Res & 3 & Range("I25")
If Range("I26") <> "" Then Res = Res & 3 & Range("I26")
If Range("I27") <> "" Then Res = Res & 3 & Range("I27")
If Range("I28") <> "" Then Res = Res & 3 & Range("I28")
If Range("I29") <> "" Then Res = Res & 3 & Range("I29")
Range("L6") = Res

Merci.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Recherche d'un fichier et extraction des données

Bonjour le forum,

J'ai le code ci-dessous qui ne fonctionne pas. Je les intégré à la suite d'un autre code qui lui par contre fonctionne parfaitement mais en rajoutant le code ci-dessous rien ne se passe. Aucune erreur ne s'affiche.

Code: 
End Select
If .Range("I20") <> "" Then Res = 1 & Range("I20")
If .Range("I21") <> "" Then Res = 2 & Range("I21")
If .Range("I22") <> "" Then Res = 3 & Range("I22")
If .Range("I23") <> "" Then Res = 4 & Range("I23")
If .Range("I24") <> "" Then Res = 5 & Range("I24")
If .Range("I25") <> "" Then Res = 6 & Range("I25")
If .Range("I26") <> "" Then Res = 7 & Range("I26")
If .Range("I27") <> "" Then Res = 8 & Range("I27")
If .Range("I28") <> "" Then Res = 9 & Range("I28")
Range("L" & lig) = Res
End If


Si une personne pouvait m'aider.

Merci.
 
Vote positif 0 Vote négatif
Re : Recherche d'un fichier et extraction des données

J'ai procédé en mettant ce code :
Code: 
If .Range("I" & k) <> "" Then Ws.Range("L" & lig) = .Range("A" & k) & .Range("I" & k)
End If
Mais il ne prend que la dernière cellule de complétée et non les autres.

Là je ne sais plus quoi faire.

Merci.
 
Vote positif 0 Vote négatif
Re : Recherche d'un fichier et extraction des données

Merci bebere j'ai juste modifié ta ligne
Code: 
If .Range("I" & k) <> "" Then Ws.Range("L" & lig) = Ws.Range("L" & lig) & " " & .Range("I" & k)

par le code suivant
Code: 
If .Range("I" & k) <> "" Then Ws.Range("L" & lig) = Ws.Range("L" & lig) & " " & .Range("A" & k) & .Range("I" & k)

Ceci afin de tenir compte également du contenu des cellules A (A20 à A28) du questionnaire satisfaction.

Juste une petite et dernière question :
SI dans mon fichier Tableau bilan questionnaire il y a deux feuilles (une feuille intitulé audit interne, une feuille intitulé bénéficiaire)

est il possible que si dans le fichier Questionnaire satisfaction en cellule D5 si elle contient "Auditeur" ou "Responsable d'audit" la macro extraira les données dans la feuille intitulée "audit interne" du fichier Tableau bilan questionnaire ou si en cellule D5 du fichier Questionnaire satisfaction il y a "Bénéficiaire" la macro extraira les données dans la feuille intitulée "bénéficiaire" du fichier Tableau bilan questionnaire.

Pour Paritec : je cloturerai le sujet dans les autres forums pas de problème.
 
Vote positif 0 Vote négatif
Re : Recherche d'un fichier et extraction des données

bonjour Henrylandes,Paritec
oui c'est possible

If .Range("D5") Like "*audit*" Then
NomF = "audit interne"
End If

If .Range("D5") Like "Bénéficiaire" Then
NomF = "Bénéficiaire"
End If
pour la suite tu mets un exemple,tu dis ce qu'il faut extraire et où le mettre
à bientôt
 
Vote positif 0 Vote négatif
Re : Recherche d'un fichier et extraction des données

Bonjour,

j'extrais les mêmes données que précédemment, donc le code vba est correct pour identifier ces données. La seule condition est la suivante :

Si en D5 dans le fichier Questionnaire satisfaction il y a soit "auditeur" ou "responsable d'audit", on extraira les données mais qui iront dans la 1er feuille du fichier Tableau bilan questionnaire intitulé "Audit interne".
Si en D5 dans le fichier questionnaire satisfaction il y a "bénéficiaire" , on extraira les données mais qui iront dans la 2ème feuille du fichier Tableau bilan questionnaire intitulée "Bénéficiaire".

Je joins le fichier Tableau bilan questionnaire avec les deux feuilles.

Ci-dessous le code modifié mais sans aucun succès.
Code: 
Private Sub CommandButton1_Click()
Dim Wb As Workbook, Ws As Worksheet
'Feuil1.Select 'Feuil1(nom de gauche en projet)
Chemin = "C:\WINDOWS\Web\" 'chemin où se trouve les fichiers'
Fichier = TextBox1.Text & ".xlsx" 'attention à l'extension
On Error Resume Next
Set Wb = Workbooks.Open(Filename:=Chemin & Fichier)
If Err <> 0 Then MsgBox "Fichier Absent": Exit Sub
Set Ws = ThisWorkbook.Worksheets("Audit interne")
lig = Ws.[A65536].End(3).Row + 1
With Wb.Sheets("Feuil1") 'Nom de la feuille du questionnaire de satisfaction'

If .Range("D5") Like "*audit*" Or "*responsable audit*" Then
NomF = "audit interne"
End If

If .Range("D5") Like "Bénéficiaire" Then
NomF = "Bénéficiaire"
End If


Ws.Range("A" & lig).Value = .TextBox4.Value
Ws.Range("B" & lig).Value = .TextBox5.Value
For k = 20 To 28
Select Case k
Case 20
If .Range("F" & k).Value = "x" Then
Ws.Range("C" & lig).Value = 1
ElseIf .Range("G" & k).Value = "x" Then
Ws.Range("C" & lig).Value = 0
ElseIf .Range("H" & k).Value = "x" Then
Ws.Range("C" & lig).Value = -1
Else
Ws.Range("C" & lig).Value = "/"
End If
If .Range("I" & k) <> "" Then Ws.Range("L" & lig) = .Range("A" & k) & .Range("I" & k)

Case 21
If .Range("F" & k).Value = "x" Then
Ws.Range("D" & lig).Value = 1
ElseIf .Range("G" & k).Value = "x" Then
Ws.Range("D" & lig).Value = 0
ElseIf .Range("H" & k).Value = "x" Then
Ws.Range("D" & lig).Value = -1
Else
Ws.Range("D" & lig).Value = "/"
End If
If .Range("I" & k) <> "" Then Ws.Range("L" & lig) = Ws.Range("L" & lig) & " " & .Range("A" & k) & .Range("I" & k)

Case 22
If .Range("F" & k).Value = "x" Then
Ws.Range("E" & lig).Value = 1
ElseIf .Range("G" & k).Value = "x" Then
Ws.Range("E" & lig).Value = 0
ElseIf .Range("H" & k).Value = "x" Then
Ws.Range("E" & lig).Value = -1
Else
Ws.Range("E" & lig).Value = "/"
End If
If .Range("I" & k) <> "" Then Ws.Range("L" & lig) = Ws.Range("L" & lig) & " " & .Range("A" & k) & .Range("I" & k)

Case 23
If .Range("F" & k).Value = "x" Then
Ws.Range("F" & lig).Value = 1
ElseIf .Range("G" & k).Value = "x" Then
Ws.Range("F" & lig).Value = 0
ElseIf .Range("H" & k).Value = "x" Then
Ws.Range("F" & lig).Value = -1
Else
Ws.Range("F" & lig).Value = "/"
End If
If .Range("I" & k) <> "" Then Ws.Range("L" & lig) = Ws.Range("L" & lig) & " " & .Range("A" & k) & .Range("I" & k)

Case 24
If .Range("F" & k).Value = "x" Then
Ws.Range("G" & lig).Value = 1
ElseIf .Range("G" & k).Value = "x" Then
Ws.Range("G" & lig).Value = 0
ElseIf .Range("H" & k).Value = "x" Then
Ws.Range("G" & lig).Value = -1
Else
Ws.Range("G" & lig).Value = "/"
End If
If .Range("I" & k) <> "" Then Ws.Range("L" & lig) = Ws.Range("L" & lig) & " " & .Range("A" & k) & .Range("I" & k)

Case 25
If .Range("F" & k).Value = "x" Then
Ws.Range("H" & lig).Value = 1
ElseIf .Range("G" & k).Value = "x" Then
Ws.Range("H" & lig).Value = 0
ElseIf .Range("H" & k).Value = "x" Then
Ws.Range("H" & lig).Value = -1
Else
Ws.Range("H" & lig).Value = "/"
End If
If .Range("I" & k) <> "" Then Ws.Range("L" & lig) = Ws.Range("L" & lig) & " " & .Range("A" & k) & .Range("I" & k)

Case 26
If .Range("F" & k).Value = "x" Then
Ws.Range("I" & lig).Value = 1
ElseIf .Range("G" & k).Value = "x" Then
Ws.Range("I" & lig).Value = 0
ElseIf .Range("H" & k).Value = "x" Then
Ws.Range("I" & lig).Value = -1
Else
Ws.Range("I" & lig).Value = "/"
End If
If .Range("I" & k) <> "" Then Ws.Range("L" & lig) = Ws.Range("L" & lig) & " " & .Range("A" & k) & .Range("I" & k)

Case 27
If .Range("F" & k).Value = "x" Then
Ws.Range("J" & lig).Value = 1
ElseIf .Range("G" & k).Value = "x" Then
Ws.Range("J" & lig).Value = 0
ElseIf .Range("H" & k).Value = "x" Then
Ws.Range("J" & lig).Value = -1
Else
Ws.Range("J" & lig).Value = "/"
End If
If .Range("I" & k) <> "" Then Ws.Range("L" & lig) = Ws.Range("L" & lig) & " " & .Range("A" & k) & .Range("I" & k)

Case 28
If .Range("F" & k).Value = "x" Then
Ws.Range("K" & lig).Value = 1
ElseIf .Range("G" & k).Value = "x" Then
Ws.Range("K" & lig).Value = 0
ElseIf .Range("H" & k).Value = "x" Then
Ws.Range("K" & lig).Value = -1
Else
Ws.Range("K" & lig).Value = "/"
End If
If .Range("I" & k) <> "" Then Ws.Range("L" & lig) = Ws.Range("L" & lig) & " " & .Range("A" & k) & .Range("I" & k)

End Select
Next
End With

Wb.Close False

End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

U
  • Question Question
Autres [RÉSOLU] Compléter la macro mais comment et où?
Réponses
2
Affichages
248
un internaute
U
F
  • Question Question
XL 2021 probleme dans la macro
Réponses
4
Affichages
184
kiki29
kiki29
VBA_dev_Anne_Marie
  • Question Question
Microsoft 365 VBA : copier les adresses
Réponses
7
Affichages
344
VBA_dev_Anne_Marie
VBA_dev_Anne_Marie
A
  • Résolu(e)
XL 2019 Remplacer un mot et ajouter une couleur
Réponses
7
Affichages
341
Attila451
A
P
  • Question Question
Microsoft 365 VBA et Segments TCD
Réponses
2
Affichages
205
patricko-13
P
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
658
Gestionnaire_rh
G
F
  • Résolu(e)
Autres Insérer une ligne
2 3
Réponses
36
Affichages
2 K
francescofrancesco
F
F
  • Question Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
463
Oneida
Oneida
KTM
  • Question Question
XL 2016 Gestion des erreurs avec la fonction RechercheV
Réponses
5
Affichages
109
KTM
KTM
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN
lynyrd
  • Question Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
667
AtTheOne
AtTheOne
thunder23
  • Résolu(e)
XL 2021 Bug dans code vba
Réponses
8
Affichages
317
thunder23
thunder23
A
  • Résolu(e)
XL 2016 Recherche d'un mot dans une cellule et surlignage de la ligne
Réponses
4
Affichages
219
Abi23
A
A
  • Question Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
351
patricktoulon
patricktoulon
T
  • Résolu(e)
Microsoft 365 VBA Exporter une sélection de plages nommées au format PDF
Réponses
12
Affichages
513
tnion
T
A
  • Question Question
XL 2010 Filtrer un Combobox en VBA excel
2 3
Réponses
43
Affichages
882
Dranreb
Dranreb
klin89
  • Question Question
Microsoft 365 Méthode Evaluate pour se dispenser d'une boucle imbriquée
Réponses
14
Affichages
491
patricktoulon
patricktoulon
S
  • Résolu(e)
Microsoft 365 Cliquer pour ouvrir des photos
Réponses
7
Affichages
516
Simon 1234
S
C
  • Résolu(e)
Autres Copier des données vers une nouvelle feuille excel VBA
2
Réponses
25
Affichages
901
Carolinebd
C
cathodique
  • Résolu(e)
XL 2010 Erreur de compilation - Incompatibilité de type: tableau ou type défini par l'utilisateur
Réponses
3
Affichages
323
cathodique
cathodique
Retour