recuperation de données

[michael]

Bonsoir

Voici le problème je dois récupérer 3 valeurs dans des fichiers qui se trouvent dans un même répertoire.
La 1er valeur est dans le 1er onglet du fichier et les valeur 2 et 3 sont dans le 2eme onglet ( les valeurs 2 et 3 sont le résultat d’un comptage de cellules (savoir combien il y a de cellules pleines) de A1 à A15 et W1 a W15.

Le hic s’est que vu le nombre de fichier variable de 20 à 233 il faut pouvoir le faire sans les ouvrir

Est ce que quelqu’un aurait un exemple de macro qui lit les valeurs sans ouvrir le fichier

Merci d’avance

michael

 

[Staple1600]

Bonsoir

Peut-être quelques infos à piocher ici:
Lien supprimé

 

[michael]

bonjour

je vais etudier ça dans la journée mais je pense que s'est ce que je recherché

merci

 

[michael]

Re:award & probleme ms jet

bonsoir

j'ai bien etudié le lien de staple1600 incroyable la puissance du truc rien qu'avec quelques modif je suis passé de 1 h 10 de boulot a 5 minutes 'genial'

award a michel xld pour se boulot et surtout pour le partage de la connaissance

par contre deux petites choses j'ai un bug :

ref : le moteur de base de données Ms jet n'a pas trouver l'objet X etc

et ensuite comment fait ton pour recuperer le nom de chaque fichiers fermés en tete de colonne

voila

encore merci a tous

 

[michael]

Re:recuperation de données suite et fin

voila j'ai resolu mes derniers petits problemes

ci joint le code si ça peux interesser quelqu'un

Sub CommandButton1_Click()

    'merci a michelXLD et  staple 1600
    Dim connect As String
    Dim sql As String
    Dim données As ADODB.Recordset
    Dim Fichier As String, Direction As String, texte_SQL As String
    Dim X As Integer, NbFichiers As Integer, Y As Integer, N As Integer, p As Integer
    Dim Tableau() As String

    
    Direction = Dir(ThisWorkbook.Path & '\\*.xls')
    Do While Len(Direction) > 0 'liste tous les classeurs du repertoire
    NbFichiers = NbFichiers + 1
    ReDim Preserve Tableau(1 To NbFichiers)
    Tableau(NbFichiers) = Direction
    Direction = Dir()
    Loop
    
    If NbFichiers > 0 Then
    For X = 1 To NbFichiers 'boucles sur les classeurs

    ' pour ne pas prendre en compte le classeur contenant la macro (synthese)
    If Tableau(X) <> ThisWorkbook.Name Then
    
        Fichier = ActiveWorkbook.Path & '\\' & Tableau(X)
        N = 0
    
    connect = 'Provider = Microsoft.Jet.OLEDB.4.0;' & _
                        'data source=' & Fichier & ';' & _
                        'extended properties=''Excel 8.0;'''
                        
    'ici la zone a copier dans la feuille dim
    sql = 'SELECT * FROM [dim$t11:t48]'
   
    Set données = New ADODB.Recordset
    données.Open sql, connect, adOpenForwardOnly, _
                adLockReadOnly, adCmdText
    
  
    Do While Not données.EOF
    ' pour etre synchro avec les colonnes
    p = X - 1
        Cells(4, 2 + p) = Tableau(X)
        Cells(N + 5, 2 + p).CopyFromRecordset données
    N = N + 1
    Loop
            
    End If
Next X
End If

Application.ScreenUpdating = True
    
'delete de l'objet recordset
données.Close
Set données = Nothing

End Sub

encore merci et bonne soirée