Copier plusieurs fichiers dans plusieurs feuilles

[mimir77]

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.

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

 

[mimir77]

Re : Copier plusieurs fichiers dans plusieurs feuilles

Personne pour m'aider s'il vous plait ?

 

[mimir77]

Re : Copier plusieurs fichiers dans plusieurs feuilles

Hello à toutes et à tous.

Personne ne veut m'aider? S'il vous plait...