Discussion :

[re]

Bonjour,
A partir du code ci-dessous comment lui indiquer le fichier à traiter par ouverture d'un fenêtre à la place de la ligne : Fichier = Dir(ThisWorkbook.Path & "\*.xlsm")
D'autre part je n'ai pas trouvé non plus ou est la ligne de départ... si x=17 il affiche les données en ligne 21
Vous l'avez compris, Je ne suis pas un expert :-(
Merci pour votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
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("q18:q30", "q32:q47", "q50:q63", "q67:q80") 'feuille source
  Col = Array(1, 3)
  For i = 1 To Sheets.Count
    'Sheets(i).Rows("2:65536").Clear
    Range("c2:h200").ClearContents
    Range("A90:h200").ClearContents
  Next
 
   Fichier = Dir(ThisWorkbook.Path & "\*.xlsm")
     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 3
           If i = 0 Then x = 17 'ligne 21
           If i = 1 Then x = 3 'ligne 33
           If i = 2 Then x = 4 ' ligne 50
            If i = 3 Then x = 5 'ligne 67
            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(1)).End(3)(x).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
 
End Sub

[laurent_ott]

Bonjour,
Je n'ai pas tout compris à votre problème, mais pour information et si ça peut vous aider :

- pour sélectionner un fichier (puis l'ouvrir après ou faire autre chose) :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Sub SélectionFichier()
Dim Fichier As String
 
Fichier = Application.GetOpenFilename("Fichier xlsm, *.xlsm")
If Fichier <> "" Then MsgBox "Fichier sélectionné : " & Fichier
 
End Sub

- Pour importer les données d'un fichier si vous connaissez son nom (normalement celui qui a été sélectionné ci-dessus, la feuille concernée et la plage ou les colonnes) :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Sub ImporterDonneesSansOuvrir()
Dim Chemin As String, Fichier As String
 
Chemin = "C:\Users\ott_l\Downloads\" ' a adapter...
Fichier = "TDB délai de paiement_30-11-2021.xlsx" ' a adapter...
 
' S'il faut importer une plage, ici A1:C54, de la feuille FDC du fichier concerné sur la feuille feuil1 du classeur actif :
ThisWorkbook.Names.Add "plage", RefersTo:="='" & Chemin & "[" & Fichier & "]FDC'!$A$1:$C$54"
    Sheets("Feuil1").[A1:C54] = "=plage"
    Sheets("Feuil1").[A1:C54].Copy
 
' S'il faut importer des colonnes, ici les colonne A à C, de la feuille FDC du fichier concerné sur la feuille feuil1 du classeur actif :
ThisWorkbook.Names.Add "plage", RefersTo:="='" & Chemin & "[" & Fichier & "]FDC'!$A:$C"
    Sheets("Feuil1").[A:C] = "=plage"
    Sheets("Feuil1").[A:C].Copy
End Sub

Cordialement.

[re]

Bonjour
Merci beaucoup pour vos conseils et merci aussi pour vos articles