Extraire donnée sans ouvir le fichier

Y

yannlion

XLDnaute Junior
Bonsoir le forum,

Après de nombreuses recherches, j'ai tenté d'écrire une macro pour extraire des données de dizaines de fichier (mon niveau est vba est débutant ...).

HTML: 
Sub recup()
Range("B2").Select
Chemin = "C:\Users\Yannick\Desktop\2015\"
Fichier = Dir(Chemin & "*.xls")

Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
If Sheets("FJUN").Visible = -1 Then
    Sheets("FJUN").Range("F4:H" & Range("F65536").End(xlUp).Row & ",AO4:AP" & Range("F65536").End(xlUp).Row).Copy
    ThisWorkbook.Activate
    ActiveSheet.Paste
    Windows(Fichier).Activate
    Application.CutCopyMode = False
End If
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Range("B65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir
Loop
End Sub

J'arrive bien au résultat escompté mais je souhaiterais faire la même chose surtout sans ouvrir les fichiers et en ne copiant que les valeurs.
Je suis aussi ouvert à toute simplification :D

Merci d'avance
Yannlion
 
Trier par date Trier par votes
Y

yannlion

XLDnaute Junior
Re : Extraire donnée sans ouvir le fichier

Bonsoir Martial,

Merci pour ton aide je ne connaissais pas le ADO.
Après réécriture j'ai un message d'erreur "Impossible de trouver le fournisseur, il est peut être ma l installé"

Voici le module :
Code: 
Sub extractionValeurCelluleClasseurFerme()
    Dim Source As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim ADOCommand As ADODB.Command
    Dim Fichier As String, Cellule As String, Feuille As String
    
    'Adresse de la cellule contenant la donnée à récupérer
    Cellule = "F4:H" & Range("F65536").End(xlUp).Row
    Cellule2 = "AO4:AP" & Range("F65536").End(xlUp).Row
      'Pour une plage de cellules, utilisez:
      'Cellule = "A4:C10"
      
    Feuille = "FMIN$" 'n'oubliez pas d'ajouter $ au nom de la feuille.
    'Chemin complet du classeur fermé
    Fichier = "C:\Users\Yannick\Desktop\2015\COMPETITIONS_2015_22_N3.xls"
                
    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
                
    Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
    End With
    Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
     
    Range("B" & Range("C65536").End(xlUp).Row).CopyFromRecordset Rst
            
    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
End Sub

Je suis en 64 bits et j'ai donc installé Microsoft ADO 6.1 library.

Une idée sur ce qui pose problème ?

Merci
Yannlion
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : Extraire donnée sans ouvir le fichier

Bonsoir Yannlion,

Difficile de te répondre sans fichier.
Mais dans le lien il est écrit
Vous devez préalablement activer la référence Microsoft ActiveX Data Objects x.x Library pour utiliser les exemples présentés dans ce tutoriel.

Dans l'éditeur de macros:
Menu Outils.
Références.
Cochez la ligne "Microsoft ActiveX Data Objects x.x Library".
Cliquez sur le bouton OK pour valider.
Cliquez pour agrandir...
Certains exemples proposés permettent de manipuler les tables et nécessitent d'activer la référence Microsoft ADO ext x.x for DLL and Security.
Cliquez pour agrandir...
et
'Définit la requête.
'/!\ Attention à ne pas oublier le symbole $ après le nom de la feuille.
texte_SQL = "SELECT * FROM [" & NomFeuille & "$]"
Cliquez pour agrandir...
De plus, chez moi, c'est ADO 6.0 et non ADO 6.1
Capture.JPG
A+

Martial
 

Pièces jointes

  • Capture.JPG
    Capture.JPG
    52.9 KB · Affichages: 112
  • Capture.JPG
    Capture.JPG
    52.9 KB · Affichages: 123
Vote positif 0 Vote négatif
Y

yannlion

XLDnaute Junior
Re : Extraire donnée sans ouvir le fichier

Bonjour Martial,

Et merci pour ton aide, grâce à toi j'ai pu adapter le code et je sens que j'approche du but !

J'arrive à importer les données sans ouvrir les fichiers mais je bute sur la variable de la dernière ligne car j'ai l'impression qu'il prend celle du fichier sur lequel je copie les données ...

Restera ensuite à faire une boucle sur tous les fichiers contenus dans le répertoire.
Les fichiers sont en pièces jointes, ce sera effectivement plus simple ;)

Merci encore pour ton aide
Yannlion
 

Pièces jointes

  • FMIN.zip
    125.6 KB · Affichages: 73
Vote positif 0 Vote négatif
Y

yannlion

XLDnaute Junior
Re : Extraire donnée sans ouvir le fichier

Bonjour Martial,

Et merci pour ton aide, grâce à toi j'ai pu adapter le code et je sens que j'approche du but !

J'arrive à importer les données sans ouvrir les fichiers mais je bute sur la variable de la dernière ligne car j'ai l'impression qu'il prend celle du fichier sur lequel je copie les données ...

Restera ensuite à faire une boucle sur tous les fichiers contenus dans le répertoire.
Les fichiers sont en pièces jointes, ce sera effectivement plus simple ;)

Merci encore pour ton aide
Yannlion
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : Extraire donnée sans ouvir le fichier

Re,

Il faut modifier ton Tableau en plage normale. Dans certains cas, ces tableaux sont appréciables dans d'autres c'est une vraie catastrophe.

Voici la macro
VB: 
Sub extractionValeurCelluleClasseurFerme()
    Dim Source As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim ADOCommand As ADODB.Command
    Dim Fichier As String, Cellule As String, Feuille As String
    
    Feuille = "FMIN$" 'n'oubliez pas d'ajouter $ au nom de la feuille.
    'Chemin complet du classeur fermé
    'Fichier = "C:\Users\Yannick\Desktop\2015\3.xlsx"
    Fichier = ThisWorkbook.Path & "\3.xlsx"
                
    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=No;"";"
                
    'Adresse de la cellule contenant la donnée à récupérer
    Cellule = "F4:H1000"
    Cellule2 = "AO4:AP1000"
      
    Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
    End With
    Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
    Range("B" & Range("B65536").End(xlUp).Row + 1).CopyFromRecordset Rst
    Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cellule2 & "]"
    End With
    Set Rst = Source.Execute("[" & Feuille & Cellule2 & "]")
      Range("E" & Range("E65536").End(xlUp).Row + 1).CopyFromRecordset Rst
    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
End Sub

A+

Martial
 
Dernière édition:
Vote positif 0 Vote négatif
Y

yannlion

XLDnaute Junior
Re : Extraire donnée sans ouvir le fichier

Re,

C'est exactement ça et ça fonctionne parfaitement sur un fichier !
Je vais devoir copier les plages de plus de 100 fichiers sur le fichier récap les unes à la suite des autres.

J'ai tenté :

Code: 
Fichier = ThisWorkbook.path & "\*.xlsx"

Do While Fichier <> ""

suite de la procédure ...

Loop

mais échec !
Une idée sur ce qui bloque ?

Merci
Yannlion
 
Dernière édition:
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : Extraire donnée sans ouvir le fichier

Re,

VB: 
Sub extractionValeurCelluleClasseurFerme()
  Dim Source As ADODB.Connection
  Dim Rst As ADODB.Recordset
  Dim ADOCommand As ADODB.Command
  Dim Fichier$, Cellule$, Feuille$
  Rows("2:65536").Clear
    Feuille = "FMIN$" 'n'oubliez pas d'ajouter $ au nom de la feuille.
    Fichier = Dir(ThisWorkbook.Path & "\*.xlsx")
     Do While Fichier <> ""
      If Fichier <> ThisWorkbook.Name Then
    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & ThisWorkbook.Path & "\" & Fichier & ";Extended Properties=""Excel 12.0;HDR=no;"";"
                
    'Adresse de la cellule contenant la donnée à récupérer
    Cellule = "F4:H1000"
    Cellule2 = "AO4:AP1000"
      
    Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
    End With
    Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
    Range("B" & Range("B65536").End(xlUp).Row + 1).CopyFromRecordset Rst
    Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cellule2 & "]"
    End With
    Set Rst = Source.Execute("[" & Feuille & Cellule2 & "]")
      Range("E" & Range("E65536").End(xlUp).Row + 1).CopyFromRecordset Rst
    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
    End If
  Fichier = Dir
Loop
Beep
End Sub
Avec un petit bip à la fin pour te prévenir.

A+

Martial
 
Vote positif 0 Vote négatif
Y

yannlion

XLDnaute Junior
Re : Extraire donnée sans ouvir le fichier

Martial,

C'est d'une rapidité bluffante !

J'aurai une dernière question pour savoir si c'est possible (promis après j'arrête de t'embêter !).
Je vais avoir au finale une vingtaine d'onglets identiques à celui-ci dans mon classeur : FCAD, FMIN, FBEN, etc. (voir http://demo.ovh.eu/fr/69c48f13a3e85715b2c1d47c2d00a0e1/)

Dans chaque fichier fermé j'irai chercher les résultats dans les onglets portant le même nom pour faire le classement par total.

Est-il possible de lancer la macro pour qu'elle s'exécute sur chaque onglet en fonction de son nom ? (dans l'onglet FPOU coller les plage de tous les onglets visibles FPOU, dans l'onglet FMIN coller les plage de tous les onglets visibles FMIN, dans l'onglet FCAD coller les plage de tous les onglets visibles FCAD, etc.)

Sinon pas de soucis je créerai autant de fichier que de catégorie et adapterai ta macro au nom de la catégorie.

Encore mille fois merci pour tout
Yannlion
 
Vote positif 0 Vote négatif
Y

yannlion

XLDnaute Junior
Re : Extraire donnée sans ouvir le fichier

Oui toujours (les 100 fichiers ont la même structure).
En fait non pour ceux dont le nom d'onglet commence par D, E ou G la 2ème plage à récupérer est en AW et AX au lieu de AO et AP.
 
Dernière édition:
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : Extraire donnée sans ouvir le fichier

Re,

Vois avec cette macro, ça doit faire ce que tu souhaites.
L'extraction se fait en fonction des feuilles de ton classeur "Classement".
Tu peux aussi changer les plages à copier plus facilement.

VB: 
Sub extractionValeurCelluleClasseurFerme()
  Dim Source As ADODB.Connection
  Dim Rst As ADODB.Recordset
  Dim ADOCommand As ADODB.Command
  Dim Fichier$, Cellule$, Feuille As Worksheet
  Dim Plage(), Col()
  Plage = Array("F4:H1000", "AO4:AP1000")
  Col = Array(2, 5)
  For i = 1 To Sheets.Count
    Sheets(i).Rows("2:65536").Clear
  Next
    Fichier = Dir(ThisWorkbook.Path & "\*.xls")
     Do While Fichier <> ""
      If Fichier <> ThisWorkbook.Name Then
        Set Source = New ADODB.Connection
        Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
          "Data Source=" & ThisWorkbook.Path & "\" & Fichier & ";Extended Properties=""Excel 12.0;HDR=no;"";"
        For Each Feuille In ActiveWorkbook.Worksheets
          For i = 0 To 1
            Cellule = Plage(i)
            Set ADOCommand = New ADODB.Command
            With ADOCommand
                .ActiveConnection = Source
                .CommandText = "SELECT * FROM [" & Feuille.Name & "$" & Cellule & "]"
            End With
            Set Rst = Source.Execute("[" & Feuille.Name & "$" & Cellule & "]")
            With Feuille
              .Cells(65536, Col(i)).End(3)(2).CopyFromRecordset Rst
            End With
          Next i
          Rst.Close
        Next
        Source.Close
        Set Source = Nothing
        Set Rst = Nothing
        Set ADOCommand = Nothing
      End If
      Fichier = Dir
    Loop
Beep
End Sub

A+

Martial

PS : Je n'avais pas vu ton message de 23h14, mais tu dois pouvoir modifier, sinon demande de l'aide ;).
 
Dernière édition:
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : Extraire donnée sans ouvir le fichier

Bonsoir yannlion,

Je n'ai pas vu d'onglets dont le nom comporte _ . Mais ça doit être contournable avec un Replace ou quelque chose de ce type.
Pour la seconde plage différentes, tu as trouvé ?

A+
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
226
Francky79
F
T
  • Question
XL 2016 Code VBA sous un macos
Réponses
4
Affichages
295
telemarrk
T
R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
178
rebatte
R
luke3300
  • Question
Microsoft 365 Erreur de macro
Réponses
4
Affichages
559
luke3300
luke3300
KTM
  • Question
XL 2016 Enregistrer un fichier sans les macros
Réponses
13
Affichages
596
KTM
KTM
Q
  • Résolu(e)
Microsoft 365 Exécutions directes différentes vs "pas à pas"
Réponses
2
Affichages
256
Quentin2106
Q
V
  • Résolu(e)
XL 2016 Exportation au format PDF à l'aide d'une macro : erreur 1004 'Document non enregistré'
Réponses
14
Affichages
600
Phil69970
Phil69970
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
632
Vermithor
V
J
  • Résolu(e)
XL 2021 Boucler sur un combobox d'une feuille Excel (Pas un Usf)
Réponses
8
Affichages
510
jozerebel
J
L
  • Résolu(e)
Microsoft 365 Pb de valeur de variable entre Sub
Réponses
5
Affichages
230
loreak
L

Membres actuellement en ligne

2 membres et 30 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 400
Messages
2 088 087
Membres
103 711
dernier inscrit
mindo