![]() |
|
Forum
|
|
|
#1 (permalink) |
|
Guest
Messages: n/a
|
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 |
| ANNONCES | |||
|
|
|
|
#2 (permalink) |
|
Guest
Messages: n/a
|
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 |
|
|
#3 (permalink) |
|
Guest
Messages: n/a
|
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 |
|
|
#4 (permalink) |
|
Guest
Messages: n/a
|
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 |
|
|
#5 (permalink) |
|
Guest
Messages: n/a
|
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 |
|
|
#6 (permalink) |
|
Guest
Messages: n/a
|
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. |
| ANNONCES | |
| Liens sociaux |
| Outils de la discussion | |
|
|