aide pour copier plage de cellules de fichiers fermés

[gilles21]

bonjour,

j'ai trouvé une macro permettant de copier une plage de cellules de tous les fichiers fermés, situés sous le meme repertoire :
----------------------------------------------------------------------------
Sub LoopThruFiles()
'Ron De Bruin, mpep
Dim place As String
Dim FilesArray() As String, FileCounter As Integer
Dim FName As String, LoopCounter As Integer

FName = Dir("C:\toto\*.xls")
Do While Len(FName) > 0
FileCounter = FileCounter + 1
ReDim Preserve FilesArray(1 To FileCounter)
FilesArray(FileCounter) = FName
FName = Dir()
Loop
If FileCounter > 0 Then
Application.ScreenUpdating = False
For LoopCounter = 1 To FileCounter

x = LoopCounter
'calcul de la plage de destination
place = Range(Cells((((x - 1) * 1) + 3), 1), Cells(((x * 1)), 3)).Address
GetValues "C:\toto", FilesArray(LoopCounter), "feuil1", "a1:c10", place
Next
Application.ScreenUpdating = True
End If
End Sub

Sub GetValues(fPath As String, FName As String, sName, _
cellRange As String, place As String)
'recopie une plage des valeurs externes dans une plage de
'la feuille active sous forme d'une formule matricielle
With ActiveSheet.Range(place)
.FormulaArray = "='" & fPath & "\[" & FName & "]" & "feuil1" & "'!" & cellRange
.Value = .Value
End With
End Sub
-------------------------------------------------------------------------------------------------
je voudrais adapter cette macro à une plage de cellules (ex A1:F1) de 7 fichiers sources , vers une plage de cellules du fichier destination (ex C10:H16)
j'imagine que tout ce passe ici:

place = Range(Cells((((x - 1) * 1) + 3), 1), Cells(((x * 1)), 3)).Address
GetValues "C:\toto", FilesArray(LoopCounter), "feuil1", "a1:c10", place

en "bidouillant", je n'ai pas obtenu de résultat ni compris comment ça marche
j'ai donc besoin d'aide pour adapter les données car je suis novice

merci d'avance

 

[michel]

bonsoir Gilles

j'espere que cette adaptation pourra t'aider


Sub ChercheFichiersFermesV02()
Dim X As Integer, NbFichiers As Integer
Dim Zone As String, Tableau() As String
Dim Direction As String

Application.ScreenUpdating = False
Direction = Dir("C:\Documents and Settings\*.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
Zone = Range(Cells(9 + X, 3), Cells(9 + X, 8)).Address ' plage C10:H...
With ActiveSheet.Range(Zone)
.Formula = "='C:\Documents and Settings\[" & Tableau(X) & "]" & "Feuil1" & "'!" & "A1:F1"
.Value = .Value
End With
Next
End If
Application.ScreenUpdating = True

End Sub


bonne soirée
MichelXld

 

[gilles21]

merci beaucoup pour ton aide qui m'a permis d'avancer

restent 3 problemes avant finalisation:

1) ce ne sont pas les cellules A1 des fichiers sources qui se retrouvent en C10:C16, mais les cellules C1 et tout est décalé
pas grave, en utilisant la plage

Zone = Range(Cells(9 + X, 1), Cells(9 + X, 6)

ça fonctionne en A10:F16

2) le fichier recap (avec la macro) est cencé se trouver sous le meme répertoire que les 7 fichiers sources
du coup, il se trouve lui meme dans la boucle en tant que "*.xls" et rajoute la ligne de ce 8eme fichier dans la plage de destination
pas grave, il me suffit de masquer cette ligne

3) le plus important:
les 7 fichiers sources sont créés chaque nuit par sortie de stats automatisée, sous un répertoire différent (jj_mm_aa)
existe-t-il un moyen de s'affranchir du chemin?
j'ai essayé un truc du genre "thisworkbook.path\*.xls" mais ça ne marche pas

encore merci

gilles21

 

[michel]

bonjour Gilles

tu peux tester cette modification


Sub ChercheFichiersFermesV03()
Dim X As Integer, NbFichiers As Integer
Dim Zone As String, Tableau() As String
Dim Direction As String

Application.ScreenUpdating = False
Direction = Dir(ThisWorkbook.Path & "\*.xls")

Do While Len(Direction) > 0
If ThisWorkbook.Name <> Direction Then 'pour ne pas prendre en compte le classeur contenant la macro
NbFichiers = NbFichiers + 1
ReDim Preserve Tableau(1 To NbFichiers)
Tableau(NbFichiers) = Direction
End If

Direction = Dir()
Loop

If NbFichiers > 0 Then
For X = 1 To NbFichiers
Zone = Range(Cells(9 + X, 1), Cells(9 + X, 6)).Address ' plage C10:H...
With ActiveSheet.Range(Zone)
.Formula = "='" & ThisWorkbook.Path & "\[" & Tableau(X) & "]" & "Feuil1" & "'!" & "A1:F1"
.Value = .Value
End With
Next
End If
Application.ScreenUpdating = True

End Sub


bonne journée
MichelXld

 

[gilles21]

Merci infiniment, Michel, ça fonctionne nickel

pour le ThisWorkbook.Path, j'en étais pas loin, juste une histoire de syntaxe

Je profite de ce post pour remercier toutes les personnes comme toi, qui ont un bon niveau de connaissances et acceptent de passer du temps à aider les débutants

bon we

gilles

 

[Evrar Kunde]

Je cherhce une Ma cro qui me permette de faire des enregistrements conditionnelles des lignes d'un tableau.
C'est à dire qu'il faudrait pouvoir descendre d'une ligne puis copier si la ligne suivante est plein et ainsi de suite tant que n'est pas vide.
Ensuit, il faudrait recopier vers une page qui servirait à incrémenter les données au fur et a mesure.

Crdlt E.K.