Bonjour a tous,
J'ai realise (adapte apres recopie plutot) une macro qui devrait les donnees d'une cellule specifique dans plusieurs fichiers.
Il n'y a qu'une feuille par fichier et cette feuille porte le nom du fichier ... Mon probleme est d'adapter le code qui suit pour que Feuil1 soit remplace par le nom de la feuille active.
Merci d'avance.
'Sub test01()
Sub chercheFichiersFermesV03()
Dim X As Integer, nbFichiers As Integer, Y As Integer
Dim Tableau() As String
Dim Direction As String
Dim Feuille As String
Application.ScreenUpdating = False
Direction = Dir("C:\Fichiers Excel\test\*.xls")
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, 1)
.Range("E2").Formula = "='C:\Fichiers Excel\test\[" & Tableau(X) & "]Feuil1" & " '!" & "A662"
End With
End If
Next X
End If
Application.ScreenUpdating = True
End Sub
poola est connecté maintenant Signaler un message hors-charte Modifier/Supprimer le message
J'ai realise (adapte apres recopie plutot) une macro qui devrait les donnees d'une cellule specifique dans plusieurs fichiers.
Il n'y a qu'une feuille par fichier et cette feuille porte le nom du fichier ... Mon probleme est d'adapter le code qui suit pour que Feuil1 soit remplace par le nom de la feuille active.
Merci d'avance.
'Sub test01()
Sub chercheFichiersFermesV03()
Dim X As Integer, nbFichiers As Integer, Y As Integer
Dim Tableau() As String
Dim Direction As String
Dim Feuille As String
Application.ScreenUpdating = False
Direction = Dir("C:\Fichiers Excel\test\*.xls")
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, 1)
.Range("E2").Formula = "='C:\Fichiers Excel\test\[" & Tableau(X) & "]Feuil1" & " '!" & "A662"
End With
End If
Next X
End If
Application.ScreenUpdating = True
End Sub
poola est connecté maintenant Signaler un message hors-charte Modifier/Supprimer le message