Re: [MACRO] 6 fichiers indiv => 1 fichier complet
Bonjour Lo, le Forum
Les deux solutions sont réalisables.
La Première risque de ralentir le traitement puisque l'on va faire une ouverture du classeur général à chaque ajout puis sauvegarde et fermeture...
La Seconde nécessite une parfaite structure identique des six fichiers pour éviter les catastrophes....
Imaginons pour la première, il suffit de faire quelques lignes de plus dans le bouton de validation de ton UserForm :
Workbooks.Open "H:\Share\General.xls"
With ActiveWorkBook..Sheets("Collection")
L = .Range("A65536").End(xlUp).Row + 1
.Range("A" & L) = TextBox1
etc etc etc
End With
ActiveWorkBook.Close True
Imaginons pour la seconde que tous les fichiers copier soient dans le même répertoire... et qu'ils contiennent des données linéaires de A à D...
Sub CollectingFiles()
Dim F As Variant
With Application.FileSearch
.NewSearch
.Filename = "*.XLS"
.LookIn = "I:\MC_Dev\Apollo\DiaryJune\Test\"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
CollectingInfo ActiveWorkbook
Next F
End With
End Sub
Sub CollectingInfo(File As Workbook)
Dim LC As Integer, LS As Integer
Dim PlageSource As Variant
Dim WSCible As Worksheet
Set WSCible = ThisWorkbook.Sheets("Collection")
With File.Sheets(1)
LS = .Range("D65536").End(xlUp).Row
PlageSource = .Range("A1
" & LS)
End With
LC = WSCible.Range("A65536").End(xlUp).Row + 1
For i = 1 To LS
WSCible.Cells(LC + i, 1) = File.Name
Next
WSCible.Range("B" & LC + 1 & ":E" & LC + LS) = PlageSource
File.Close 0
End Sub
Je te laisse faire des essaies....
Bon App, je file déjeuner
@+Thierry