R
Riri
Guest
Bonsoir le Forum ,
la macro jointe permet de lister tous les classeurs d'un répertoire et récupère les données de la cellule A1(Feuil1) de chaque fichier sans l'ouvrir.
Macro de MichelXLD que je remercie au passage.
Ce que je n'arrive pas à faire , c'est récupérer plusieurs lignes sur chaques classeurs.De la première ligne à la dernière ligne non vide .
Exemple : Récupérer la ligne 5 , 6 , 7 , ect ..... . colonnes A , B , C , D , E de Chaques classeurs .
Merci pour votre Aide et bonne soirée à vous .
Eric . D
'Macro de MichelXLD
Sub chercheFichiersFermesV03()
Dim X As Integer, nbFichiers As Integer, Y As Integer
Dim Tableau() As String
Dim Direction As String
Application.ScreenUpdating = False
Direction = Dir('C:\\Documents and Settings\\michel\\dossier\\general\\excel\\*.xls') '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, 1)
.Formula = '='C:\\Documents and Settings\\michel\\dossier\\general\\excel\\[' & Tableau(X) & ']Feuil1' & ''!' & 'A1'
.Value = .Value
End With
End If
Next X
End If
Application.ScreenUpdating = True
End Sub
la macro jointe permet de lister tous les classeurs d'un répertoire et récupère les données de la cellule A1(Feuil1) de chaque fichier sans l'ouvrir.
Macro de MichelXLD que je remercie au passage.
Ce que je n'arrive pas à faire , c'est récupérer plusieurs lignes sur chaques classeurs.De la première ligne à la dernière ligne non vide .
Exemple : Récupérer la ligne 5 , 6 , 7 , ect ..... . colonnes A , B , C , D , E de Chaques classeurs .
Merci pour votre Aide et bonne soirée à vous .
Eric . D
'Macro de MichelXLD
Sub chercheFichiersFermesV03()
Dim X As Integer, nbFichiers As Integer, Y As Integer
Dim Tableau() As String
Dim Direction As String
Application.ScreenUpdating = False
Direction = Dir('C:\\Documents and Settings\\michel\\dossier\\general\\excel\\*.xls') '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, 1)
.Formula = '='C:\\Documents and Settings\\michel\\dossier\\general\\excel\\[' & Tableau(X) & ']Feuil1' & ''!' & 'A1'
.Value = .Value
End With
End If
Next X
End If
Application.ScreenUpdating = True
End Sub