Bonjour à tous les amis,
Je viens consulter votre sagesse pour une macro dont j'aurais besoin.
J'aimerais avoir une macro qui me permette de copier une feuille appeler "Matrice" qui se situe sur une centaine de fichiers localisés dans un dossier qui ont la même mise en forme et de coller les données dans un nouveau fichier excel qui servira de recap avec comme nom de feuille une cellule par exemple A3 de la feuille "Fiche".
Mon fichier Recap aura au final plusieurs centaines de feuilles. Je ne veux pas coller les infos les unes en dessous des autres mais feuille par feuille.
Je vous remercie pour votre aide.
J'ai une macro sous le coude qui est issue de ce forum comme base.
Merci à tous.
Je viens consulter votre sagesse pour une macro dont j'aurais besoin.
J'aimerais avoir une macro qui me permette de copier une feuille appeler "Matrice" qui se situe sur une centaine de fichiers localisés dans un dossier qui ont la même mise en forme et de coller les données dans un nouveau fichier excel qui servira de recap avec comme nom de feuille une cellule par exemple A3 de la feuille "Fiche".
Mon fichier Recap aura au final plusieurs centaines de feuilles. Je ne veux pas coller les infos les unes en dessous des autres mais feuille par feuille.
Je vous remercie pour votre aide.
J'ai une macro sous le coude qui est issue de ce forum comme base.
Merci à tous.
Code:
Sub compilationClasseurs()
Dim W As Workbook, WL As Workbook, DCel As Range, i As Long
Dim adressesF, adressesM, k As Byte, l As Byte
adressesM = _
Array("Q6", "R7", "S6", "T7", "S7", "R9", "Q7", "T9", _
"Q8", "R11", "S8", "T11", "Q9", "R13", "S9", "T13", _
"Q17", "R18", "S17", "T18", "Q22", "R23", "S22", "T23", _
"Q24", "R29", "S24", "T29", "Q34", "R41", "S34", "T41")
adressesF = _
Array("E2", "E7", "H7", "E19", "E21", "E23", _
"E25", "E29", "E31", "E33", "E51", _
"E53", "M3", "M5", "M45", _
"M47", "M49", "M51", "M55")
Application.ScreenUpdating = False
On Error Resume Next
Set W = ThisWorkbook
With Application.FileSearch
.NewSearch
.LookIn = "C:\Documents and Settings\FRESAPM\Bureau\New matrice" 'ADAPTER LE CHEMIN
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Set WL = Workbooks.Open(.FoundFiles(i), 0)
Set DCel = W.Sheets("Compilation_DONNEES").[A65536].End(xlUp).Offset(1, 0)
For k = LBound(adressesF) To UBound(adressesF)
DCel.Offset(, k) = WL.Sheets("FICHE").Range(adressesF(k))
Next
For l = LBound(adressesM) To UBound(adressesM)
DCel.Offset(, l + 18) = WL.Sheets("MATRICE").Range(adressesM(l))
Next
WL.Close False
Next i
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Set W = Nothing
Set WL = Nothing
Set DCel = Nothing
End Sub
