Re : extraire données dans plusieurs classeur fermé excel
Bonjour Max, bonjour le Forum,
Désolé pour l'attente, mais j'étais un peu occupé !
Voici ton fichier dans lequel on ne conserve que les "p3" sans filtre.
J'espère avoir répondu à ton besoin.
Cordialement
Joël
Merci beaucoup ceci fonctionne.mais un peu long pour tous mes fichiers(18)
j'ai pensé utiliser la fonction"ADODB.connection" en plus celle-ci ne m'ouvre pas physiquement les classeurs.
j'ai créé une macro mais celle-ci m'indique "Erreur d'éxécution'13': Incompatibilité de type"
Voici ma macro:
Sub RequeteClasseurFerme()
Dim Repertoire As String
Dim Cn As ADODB.Connection
Dim Fichier As String
Dim NomFeuille As String, texte_SQL As String
Dim Rst As ADODB.Recordset
Dim x As Integer
'empeche le scintillement de l'écran
Application.ScreenUpdating = False
'Définit le classeur fermé servant de base de données
Repertoire = "C:\Nom\"
Fichier = Dir(Repertoire & "\*.xls")
' va parcourir le répertoire pour y trouver tous les fichiers excel,et pour chaque fichier trouvé,
'en extraire le contenu de la feuille "plan" et le placer dans la feuille
'"Feuil1" du classeur actif
Do While Fichier <> ""
Set Cn = New ADODB.Connection
'Etablit la connection
With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & Fichier & _
";Extended Properties=Excel 8.0;"
.Open
End With
'Nom de la feuille dans le classeur fermé
NomFeuille = "Plan"
'Définit la requête (Attention à ne pas oublier le symbole $ après le nom de la feuille).
texte_SQL = "SELECT * FROM [" & NomFeuille & "$] WHERE Id_skill <> 0"
If Application.Workbooks([" & NomFeuille & "$]).Worksheets("plan d'actionVPI").Range("I" & i).Value = "p3" Then
Worksheets("Feuil1").Range("B" & j & ":B" & j).Value = Application.Workbooks([" & NomFeuille & "$]).Worksheets("plan").Range("C" & i & ":C" & i).Value
Worksheets("Feuil1").Range("D" & j & ":E" & j).Value = Application.Workbooks([" & NomFeuille & "$]).Worksheets("plan").Range("D" & i & ":E" & i).Value
Worksheets("Feuil1").Range("I" & j & ":I" & j).Value = Application.Workbooks([" & NomFeuille & "$]).Worksheets("plan").Range("G" & i & ":G" & i).Value
Worksheets("Feuil1").Range("M" & j & ":M" & j).Value = Application.Workbooks([" & NomFeuille & "$]).Worksheets("plan").Range("H" & i & ":H" & i).Value
Worksheets("Feuil1").Range("G" & j & ":G" & j).Value = Application.Workbooks([" & NomFeuille & "$]).Worksheets("plan").Range("E2").Value
Worksheets("Feuil1").Range("J" & j & ":J" & j).Value = Application.Workbooks([" & NomFeuille & "$]).Worksheets("plan").Range("F" & i & ":F" & i).Value
Worksheets("Feuil1").Range("F" & j & ":F" & j).Value = Application.Workbooks([" & NomFeuille & "$]).Worksheets("plan").Range("B" & i & ":B" & i).Value
End If
Set Rst = New ADODB.Recordset
Set Rst = Cn.Execute(texte_SQL)
'Ecrit le résultat de la requête à partir de la première ligne du classeur actif
'qu'il trouve vide (dont la cellule Ai est vide)
x = ThisWorkbook.Sheets("Feuil1").Range("A65536").End(xlUp).Row + 1
ThisWorkbook.Sheets("Feuil1").Cells(x, 1).CopyFromRecordset Rst
'Ferme la connection
Rst.Close
Set Rst = Nothing
Cn.Close
Set Cn = Nothing
'passe au fichier suivant
Fichier = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Opération terminée."
End Sub
Quelqu'un peux-t'il m'aider?
