Recherche d'un fichier et extraction des données

[henrylandes]

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.

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.

 

[Bebere]

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

 

[henrylandes]

Re : Recherche d'un fichier et extraction des données

Bonjour Bebere

après avoir repris ton code, il me marque l'erreur suivante : erreur de compilation : Next sans For

Merci.

 

[Bebere]

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

 

[henrylandes]

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é

"codespostaux.xls"

puisque je pensais que mettre

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.

 

[Bebere]

Re : Recherche d'un fichier et extraction des données

Bonjour henrylandes
changé texte entêtes des colonnes c à K pour avoir même ordre que 1 à 9 de fichier questionnaire
pour L pas compris
à bientôt

 

[henrylandes]

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 :

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.

 

[henrylandes]

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.

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.

 

[henrylandes]

Re : Recherche d'un fichier et extraction des données

J'ai procédé en mettant ce 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.

 

[Bebere]

Re : Recherche d'un fichier et extraction des données

bonjour Henrylandes
le fichier modifié
à bientôt

 

[Paritec]

Re : Recherche d'un fichier et extraction des données

bonsoir Bebere🙂 henrylandes le forum
Il est de coutume de préciser le multipostage et là tu en est tout de même à 3 forums!!!!!!
a+
papou🙂

 

[henrylandes]

Re : Recherche d'un fichier et extraction des données

Merci bebere j'ai juste modifié ta ligne

If .Range("I" & k) <> "" Then Ws.Range("L" & lig) = Ws.Range("L" & lig) & " " & .Range("I" & k)

par le code suivant

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.

 

[Bebere]

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

 

[henrylandes]

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.

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

 

[Bebere]

Re : Recherche d'un fichier et extraction des données

bonjour henrylandes
tu mets ces 2 lignes après les 2 if qui détermine nomf
Set Ws = ThisWorkbook.Worksheets(nomf)
lig = Ws.[A65536].End(3).Row + 1
à bientôt