Discussion :

[bczouhair]

Bonjours ;

je voudrais créer une macro sous excel qui permet de copier des cellules contenus dans des fichiers.xls appartenant à un dossier qlq et les mettre dans un seul tableau excel .

avant d'expliquer le prb ,je vous laisse à découvrir une partie de mon prograamme :

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
     lParam As Long
    iImage As Long
End Type

Sub essai()
Dim compt As Integer
Dim lin As String
Dim file As String
Dim zaza As String, brinf As BrowseInfo
Dim dossier As String



'choix du répertoire
dialg = SHBrowseForFolder(brinf) 'affiche la boite de dialogue
zaza = Space(200) 'crée un tampon zaza
SHGetPathFromIDList dialg, zaza 'charge le chemin dans le tampon
dossier = Left(zaza, InStr(1, zaza, Chr(0)) - 1)

j = 10
file = Dir(dossier & "\*.xls")
Do Until file = ""
Workbooks.Open Filename:=dossier & "\" & file

file = Dir

Sheets("inv des captages").Select

'comptage 
i = 15
compt = 0
While (Cells(i, 1) <> "")
i = i + 1
compt = compt + 1
Wend
'fin de comptage :valeur de sortie est compt


'conversion
Windows("................................xls").Activate 'ouverture du fichier oû on va mettre les valeurs
Sheets("..........").Select 


For i = 1 To compt

lin = "R" & i + 14 & "C" & 1
Cells(j, 1).FormulaR1C1 = _
        "='[" & file & "]inv des captages'!" & lin
        
lin = "R" & i + 14 & "C" & 2
Cells(j, 2).FormulaR1C1 = _
        "='[01-Centre Production SAFI_01_10.xls]inv des captages'!" & lin

.......................'similaire               

               j = j + 1
Next i

Loop


End Sub

j ai des prbs dans la partie en rouge ;d'apres mes connaissances file est une variable qui contient le nom du fichier à ouvrir ,donc j ai le droit de la mettre dans la formule que j'ai écrit daanss mon programme,mais le excel affiche un message d'erreur ! comment je vais m en sortir

aidez mois SVP


merci

[mercatog]

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
52
Option Explicit
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type
 
Sub essai()
Dim Brinf As BrowseInfo
Dim Wbk As Workbook
Dim Sh As Worksheet, aSh As Worksheet
Dim LastLig As Long, j As Long
Dim File As String, Zaza As String, Dossier As String, Dialg As String
 
Dialg = SHBrowseForFolder(Brinf)    'affiche la boite de dialogue
Zaza = Space(200)    'crée un tampon zaza
SHGetPathFromIDList Dialg, Zaza    'charge le chemin dans le tampon
Dossier = Left(Zaza, InStr(1, Zaza, Chr(0)) - 1)
If Len(Dossier) > 1 Then
    File = Dir(Dossier & "\*.xls")
    Set aSh = ThisWorkbook.Sheets("Feuil1")    'adapter le nom de la feuille destination
    j = 10
    Application.ScreenUpdating = False
    Do Until File = ""
        Set Wbk = Workbooks.Open(Dossier & "\" & File)
        On Error Resume Next
        Set Sh = Wbk.Sheets("inv des captages")
        On Error GoTo 0
        If Not Sh Is Nothing Then
            With Sh
                LastLig = .Cells(Rows.Count, 1).End(xlUp).Row
                If LastLig > 15 Then
                    aSh.Range("A" & j & ":B" & LastLig + j - 15).Value = .Range("A15:B" & LastLig).Value
                    j = j + LastLig - 14
                End If
            End With
        End If
        Wbk.Close
        Set Sh = Nothing
        Set Wbk = Nothing
        File = Dir
    Loop
    Set aSh = Nothing
End If
End Sub

[bczouhair]

Bonjour;

Je vous remercie "mercatog" pour votre aide ,votre programme marche tres ,merci .

mais ce que je cherche plus précisément c est comment exploiter les données des fichiers et les mettre dans la page de destination .
j ai utilisé le programme suivant mais ça marche pas :

Code :

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

1
2
3
lin = "R" & i + 14 & "C" & 1
Cells(j, 1).FormulaR1C1 = _
        "='[" & file & "]feuille'!" & lin

merci