Re : AUTOMATISER, le copier/coller de fichiers dans un autre
reBonsoir le forum,
J'ai, je pense trouvé une solution en deux parties, mai je ne sais pas assembler les deux VBA. Je ne sais pas si elle est complète...je ne sais rien en fait, c'est du Grecque pour moi ! Mais visiblement une fois assemblé, ça a l'air de fonctionner !
En tout cas, ce que j'ai trouvé est ce que je veux faire.
La question de la personne: >
--------------------------------------------------------------------------
En esperant être le plus clair possible :
Je souhaite créer un module permettant d'aller récupérer une liste d'information dans un grand nombre de fichier excel situé dans une arborescence du type dossier/sous-dossiers/sous-sous-dossiers/../fichier.xls
Les informations récupérées doivent être listées dans les lignes et colonnes d'un classeur existant et possèdant déjà de nombreux champs informés. Il faut donc qu'une information importé des classeurs soit reconnue dans celui existant (mais mon probleme n'est pas là).
Chacun des classeurs 'Excel' ont un début de nom commun.
Ils sont également tous structurés de la même façon.
La VBA de la personne: >
Dim s As String
Dim n As Double
Function trouvenum_precedent(num As String) As Double ' retourne le numéro de ligne
' du numéro passé en paramètre
Dim c As Range
Set c = Workbooks("donnes-recuperer.xls").Worksheets("Feuill1").Range("U:U").Find(num)
If c Is Nothing Then
MsgBox (num & " non trouvé ")
trouvenum_precedent = "0"
Else
trouvenum_precedent = c.Row
End If
End Function
Sub recup_donnees()
Workbooks.Open Filename:="D:\partage\Dossier\Sous-Dossier\Sous-Sous-Dossier\Données\Annexe \01\nom1\" & "données.xls"
s = Workbooks("données.xls").Worksheets("Feuil1").Cells(3, 1)
n = InStrRev(s, " ")
s = Right(s, Len(s) - n)
n = trouvenum_precedent(s)
For i = 52 To 71
Workbooks("donnes-recuperer.xls").Worksheets("Feuill1").Cells(n, i) = Workbooks("données.xls").Worksheets("Feuil1").Cells(i - 47, 7)
Next i
Workbooks("données.xls").Close False
Workbooks.Open Filename:="D:\partage\Dossier\Sous-Dossier\Sous-Sous-Dossier\Données\Annexe \01\nom1\" & "données.xls"
s = Workbooks("données.xls").Worksheets("Feuil2").Cells(3, 1)
n = InStrRev(s, " ")
s = Right(s, Len(s) - n)
n = trouvenum_precedent(s)
For i = 72 To 87
Workbooks("donnes-recuperer.xls").Worksheets("Feuill1").Cells(n, i) = Workbooks("données.xls").Worksheets("Feuil2").Cells(i - 67, 7)
Next i
Workbooks("données.xls").Close False
End Sub
-----------------------------------------------------------------------
Voilà où j'en suis.
Pour l'instant le contrat est remplit pour une seul importation.
Je voudrais savoir s'il est possible d'écrire une fonction permettant d'aller scanner les informations dans une arborescence contenant environ 200 fichiers excel.
(les fichiers excels ont en commun le début de leur nom ainsi que leur structure)
--------------------------------------------------------------------------
La réponse d'un internaute: >
Tu dois ouvrir un certain nombre de fichiers.
Tu dois donc parcourir un répertoire pour en avoir la liste, puis les traiter l'un après l'autre.
Question 1 : As-tu des difficultés pour établir cette liste ?
La liste établie, dans la sub, tu crées une boucle sur les noms de la liste.
Pour chaque nom, tu crées l'instance du fichier ouvert
Public FL1 as worksheet
Dim s As String
Dim n As Double
Sub recup_donnees()
Dim ListFich()
Dim CLn as workbook
Dim FL2 as worksheet
Set FL2 = Workbooks("donnes-recuperer.xls").Worksheets("Feuill1")
Rep = :="D:\partage\Dossier\Sous-Dossier\Sous-Sous-Dossier\Données\Annexe \01\nom1\"
'Créer la liste dans ListFich()
For NoFich = 1 to Ubound(ListeFich)
Set CLn = Workbooks.Open Filename:= Rep & ListeFich(NoFich)
Set FL1 = Cln.Worksheets("Feuil1")
s = FL1.Cells(3, 1)
n = InStrRev(s, " ")
s = Right(s, Len(s) - n)
'Pour appeler ta fonction, joins l'instance de ta feuille
n = trouvenum_precedent(s)
For i = 52 To 71
FL2.Cells(n, i) = FL1.Cells(i - 47, 7)
Next i
Set FL1 = Nothing 'pas indispensable
Next NoFich
End subEt dans la fonction,
Function trouvenum_precedent(num As String) As Double ' retourne le numéro de ligne
' du numéro passé en paramètre
Dim c As Range
Set c = FL1.Range("U:U").Find(num)
If c Is Nothing Then
MsgBox (num & " non trouvé ")
trouvenum_precedent = "0"
Else
trouvenum_precedent = c.Row
End If
End FunctionPour la liste des fichiers, ce n'est pas impératif. Tu peux faire en sorte que les fichier soient listés dans la boucle. Regarde là ([VBA-*]Lister, Ouvrir, Renommer, Supprimer les fichiers d'un répertoire - Forum des développeurs, Tu peux placer le code entre For NoFich = 1 to Ubound(ListeFich) et Next NoFich dans la boucle For each des exemples. Juste un exemple
A+
--------------------------------------------------------------------------