Procédure trop longue

Bonjour,

Je souhaite réduire mon code car il est trop long pour excel je sais qu'il n'est pas du tout opti mais je n'ai pas forcement toutes les connaissances pour le faire, pourriez-vous m'aider ?

ci-joint une petite partie de mon code que je répète tout le long

Bonjour,

La macro ne suffit pas ; idéalement il faudrait la "source" et la "cible"...

Ma question était stupide donc je la supprime. En l'absence de fichier test c'est assez nébuleux donc je t'ai fait le premier bloc : s'en inspirer pour la suite.

Sub importDonnees()
Dim wb As Workbook
Dim principal As ThisWorkbook, Arr, Src, WsT
Dim repertoire As String, fichier As String
Set WsT = ThisWorkbook.Worksheets("copie")
    'Application.ScreenUpdating = False
    Set principal = ThisWorkbook
    repertoire = "C:\cheminacces"
    ChDir repertoire
    fichier = Dir("*.xls")
    Do While fichier <> "" ' je boucle jusqua que le nom du fichier = vide
        If fichier <> principal.Name Then ' je regarde a ce que ma variable "fichier" nest pas egal a mon fichier principal
            Workbooks.Open fichier
                For b = 1 To 6 Step 1
'Bruz
                    If InStr(1, Sheets(b).Name, "tes45", vbTextCompare) Then ' si dans le nom de la feuille j'ai le nom du site
                    site = Sheets(b).Name

                        For i = 1 To 3 Step 1 ' cette boucle me permet de parcourir les feuilles, ne pas remplacler 3 par un nombre plus grand que le nombre de feuilles
                            If InStr(1, Sheets(i).Name, "test 12", vbTextCompare) Then 'ici on recherche dans notre feuille si " " est present

                                MsgBox Sheets(i).Name, vbButtonType, "msgTitle" 'messages que pour le test (a retirer)
                                Set Src = Sheets(i)
With WsT

    Arr = Src.Range("E3:E7").Value: .Range("D6:10") = Arr: Erase Arr
      .Range("K6") = Src.Range("E16")
      .Range("N6") = Src.Range("E17")
      .Range("L6") = Src.Range("E26")
      .Range("O6") = Src.Range("E27")
      .Range("Q6") = Src.Range("E36")
      .Range("S6") = Src.Range("E37")
      .Range("Y7") = Src.Range("E39")
      .Range("Y8") = Src.Range("E40")
      .Range("AD6") = Src.Range("E42")
      .Range("AE6") = Src.Range("E43")
      .Range("AH6") = Src.Range("E44")
      .Range("AI6") = Src.Range("E45")
      .Range("AD28") = Src.Range("E46")
      .Range("AE28") = Src.Range("E47")
    Arr = Src.Range("E50:E54").Value: .Range("D6:10")= Arr: Erase Arr
    Arr = Src.Range("E59:E64").Value: .Range("BA8:BA13")= Arr: Erase Arr
    Arr = Src.Range("E66:E68").Value: .Range("BG5:BG7")= Arr: Erase Arr
    Arr = Src.Range("E70:E77").Value: .Range("BM6:BM13")= Arr: Erase Arr
      .Range("BS5") = Src.Range("E79")
    Arr = Src.Range("E81:E84").Value: .Range("BY4:BY7")= Arr: Erase Arr
    Arr = Src.Range("E86:E87").Value: .Range("CE4:CE5")= Arr: Erase Arr
    Arr = Src.Range("E89:E92").Value: .Range("CK5:CK8"= Arr: Erase Arr
    Arr = Src.Range("E94:E95").Value: .Range("CQ4:CQ5")= Arr: Erase Arr
End With
'--------------- FIN DE COPIER COLLER POUR ----------------

A+

Bonjour,
Merci pour ta réponse j'ai également épurer le code c'est nickel !

Merci