Discussion :

[roidurif]

Bonjour,

J'ai plusieurs fichiers contenant dix feuilles chacun situé dans un répertoire.

Le but est de récupérer deux données (cellules "A6" et "B6") situé dans les onglets ('Lundi', 'Mardi', 'Mercredi', 'Jeudi',...,'Dimanche') pour chacun des fichiers et ensuite de les rassembler en colonne dans le fichier 'Données'

Voici un bout de code, mais impossible de l'ajuster à mon fichier

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
 
 
Option Explicit
 
Sub Importer2()
Dim i As Long
Dim j As Byte
Dim sDossier As String, sFichier As String, sFeuille As Worksheet
'sFeuille As String
 
    Application.ScreenUpdating = False
 
    ShDatas.Range("B1:C65536").Clear
    sDossier = ThisWorkbook.Path & "\"
    sFeuille1 = "Lundi"
    sFeuille2 = "Mardi"
    sFeuille3 = "Mercredi"
    sFeuille4 = "Jeudi"
    sFeuille5 = "Vendredi"
    sFeuille6 = "Samedi"
    sFeuille7 = "Dimanche"
 
 
 
    For i = 1 To 4
    'For j = 1 To Sheets.Count
 
 
        With ShDatas
            sFichier = .Cells(i, 1)
            .Cells(i, 2) = ExtraireValeur(sDossier, sFichier, sFeuille1, "A6")
            .Cells(i, 2) = CDate(Cells(i, 2))
            .Cells(i, 3) = ExtraireValeur(sDossier, sFichier, sFeuille1, "B6")
            .Cells(i, 3) = Cells(i, 3)
 
        End With
 
    Next i
 
    Application.ScreenUpdating = True
End Sub
 
Private Function ExtraireValeur(ByVal Dossier As String, ByVal Fichier As String, ByVal Feuille As String, ByVal Cellule As String)
Dim Argument As String
    Argument = "'" & Dossier & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Address(, , xlR1C1)
    ExtraireValeur = ExecuteExcel4Macro(Argument)
End Function