Sub Programme()
Dim X As Integer, nbFichiers As Integer, Y As Integer
Dim Tableau() As String
Dim Direction As String
Dim Txt As String
Application.ScreenUpdating = False
Dim resultat As String
resultat = InputBox("Texte ?", "Chemin des Bacaras", "D:\???\*.xls") 'La variable reçoit la valeur entrée dans l'InputBox
If resultat <> "" Then 'Si la valeur est différente de "" on affiche le résultat
MsgBox resultat
End If
Txt = resultat
Direction = Dir(D:\???\) 'adapter chemin repertoire
Do While Len(Direction) > 0
nbFichiers = nbFichiers + 1
ReDim Preserve Tableau(1 To nbFichiers)
Tableau(nbFichiers) = Direction
Direction = Dir()
Loop
If nbFichiers > 0 Then
For X = 1 To nbFichiers
If Tableau(X) <> ThisWorkbook.Name Then
Y = Y + 1
'**********************************************************************************************************************
With ActiveSheet.Cells(Y + 3, 1)
.Formula = "='D:\???\[" & Tableau(X) & "]Budget" & "'!" & "SecCod"
.Value = .Value
End With
With ActiveSheet.Cells(Y + 3, 2)
.Formula = "='D:\???\[" & Tableau(X) & "]Budget" & "'!" & "SecLib"
.Value = .Value
End With
With ActiveSheet.Cells(Y + 3, 3)
.Formula = "='D:\???\[" & Tableau(X) & "]Budget" & "'!" & "L13"
.Value = .Value
End With
With ActiveSheet.Cells(Y + 3, 4)
.Formula = "='D:\???\[" & Tableau(X) & "]Budget" & "'!" & "L67"
.Value = .Value
End With
'*********************************************************************************************************************
End If
Next X
End If
With ActiveSheet.Cells(Y + 4, 3)
.Formula = "=SUBTOTAL(9,R4C:R[-1]C)"
End With
With ActiveSheet.Cells(Y + 4, 4)
.Formula = "=SUBTOTAL(9,R4C:R[-1]C)"
End With
Application.ScreenUpdating = True
End Sub