Plantage Excel lors de l’exécution d'une macro

Bonjour,

J'utilise la macro ci-dessous qui consiste à vérifier entre 2 fichiers si une valeur existe et en fonction de si elle existe ou non copier la ligne ou mettre une date dans une cellule.

Il y a un fichier de base (fichier matrice) qui sert pour toute l'année et une liste de fichiers avec lesquels je vais faire la comparaison.

Dans les fichiers que j'ai mis en pj, il y 1 ligne mais dans la réalité les fichiers font 4000 à 5000 lignes.

Quand je lance la macro, s'il y a 1 fichier à comparer ça va mais s'il y en a plus (ça peut aller jusqu'à 30) excel plante au bout d'un moment avec le message "Excel a cesser de fonctionner, relancer Excel" et un fois j'ai eu "Erreur Automation, une erreur s'est produite".

Savez-vous d'où ça peut venir ? Est-ce parce que les fichiers sont trop volumineux ? Ou c'est ma macro qui est pourrie ?

Merci d'avance.

Sub Pilotage_des_feux()
'
' Pilotage_des_feux Macro
'
'déclaration des variables
Dim resultat As Range
Dim valeur As Range
Dim feujour As Range
Dim feuveille As Range
Dim dateorange As Range
Dim datevert As Range
Dim MyFiles() As String

Windows("Pilotage des Feux.xlsm").Activate
Worksheets("Feuil1").Activate

chemin = Worksheets("Feuil1").Range("A2").Value 'chemin où sont les fichiers
chemin2 = Worksheets("Feuil1").Range("A4").Value 'chemin du fichier matrice
fichier2 = Worksheets("Feuil1").Range("B4").Value 'Fichier matrice
fichier = Dir(chemin)

'ouverture du fichier matrice
ChDir "" & chemin2 & ""
Workbooks.OpenText Filename:= _
        "" & chemin2 & "" & fichier2 & ".xls"

'On récupère le nom de l'onglet dans une variable
nomonglet2 = ActiveSheet.Name

'On boucle dans le répertoire définit pour réucpérer tous les fichiers qui sont présents
Do While fichier <> ""
    ReDim Preserve MyFiles(j)
    MyFiles(j) = fichier
    j = j + 1
    fichier = Dir()
Loop

Workbooks.Open chemin & MyFiles(0) 'on ouvre le 1er fichier du répertoire

'For j = LBound(MyFiles) + 1 To UBound(MyFiles)
For j = LBound(MyFiles) To UBound(MyFiles) 'on va ouvrir les fichiers du répertoire définit au fur et à mesure pour faire les tests

Workbooks.Open chemin & MyFiles(j)
nomonglet = ActiveSheet.Name 'on récupère le nom de l'onglet dans une variable
Sheets(nomonglet).Activate
pgmitim = "PGM_ ITIM SURVEILLANCE FEU " 'permettra ensuite de récupérer la date de fichier du jour par rapport au nom du fichier du jour
Columns("H:I").EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'on ajoute 2 colonnes H et I pour pouvoir faire le copier/coller dans le fichier matrice avec le même nombre de colonnes
'Permet de récupérer la date J-1 du fichier du jour (ex : PGM_ ITIM SURVEILLANCE FEUX 20092018, on récupère 19/09/2018)
datewb = Replace(Replace(MyFiles(j), pgmitim, ""), ".xls", "")
datewb = DateSerial(Right(datewb, 4), Mid(datewb, 3, 2), Left(datewb, 2))
'on compte le nombre de lignes du fichier
Range("A4").Select
Selection.End(xlDown).Select
fin = ActiveCell.Row

    For i = 4 To fin 'On va de la valeur 2 à la valeur fin

    Set valeur = Sheets(nomonglet).Cells(i, 1) 'la variable valeur aura comme résultat i = 4 à fin et 1 = colonne A (donc A4 à A"fin") - càd n° de référence unique sur lequel on fera la recherche
    Set feujour = Sheets(nomonglet).Cells(i, 7) 'la variable feujour aura comme résultat i = 4 à fin et 7 = colonne G (donc G4 à G"fin")

'    Orange = "H" & i & "" 'Orange servira à aller sur la case H4 à H"fin"
'    Vert = "I" & i & "" 'Vert servira à aller sur la case I4 à I"fin"

    Windows("" & fichier2 & ".xls").Activate 'On va sur le fichier matrice
    Set resultat = Sheets(nomonglet2).Columns(1).Find(What:=valeur, LookAt:=xlWhole, MatchCase:=False) 'On fait un find sur le fichier matrice pour trouver la donnée "valeur"
    On Error Resume Next

    Set feuveille = Sheets(nomonglet2).Range("G" & resultat.Row) 'on récupère la valeur de la case G4 à G"fin"
    On Error Resume Next
    feuveille = Range("G" & resultat.Row).Value
'    Set dateorange = Sheets(nomonglet2).Cells(i, 8) 'on récupère la valeur de la case H4 à H"fin"
'    Set datevert = Sheets(nomonglet2).Cells(i, 9) 'on récupère la valeur de la case I4 à I"fin"
'     Orange = Sheets(nomonglet2).Cells(resultat.Row, 8)
'     Vert = Sheets(nomonglet2).Cells(resultat.Row, 8)

        If resultat Is Nothing And feujour = "Feu orange Arrivée" Then 'si on ne trouve pas la variable "resultat" dans le fichier matrice et que la case Gx contient "Feu Orange Arrivée" dans le fichier du jour
        Windows(MyFiles(j)).Activate                        'alors on va sur le fichier du jour, on copie la ligne
        Range("A" & i & "").EntireRow.Select
        Selection.Copy
        Windows("" & fichier2 & ".xls").Activate                                 'on colle la ligne tout en bas du fichier matrice et on on met la date du fichier jour en colonne Hx
        Range("A4").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        ActiveSheet.Paste
        ActiveCell.Offset(0, 7).Select
        ActiveCell.Value = datewb

           Else
            'Set feuveille = Sheets(nomonglet2).Cells(resultat.Row, 7)  'on récupère la valeur de la case G4 à G"fin"

            'si on trouve la variable "resultat" dans le fichier matrice et que la donnée "Feu vert Arrivée" du fichier du jour est renseignée
            'et que la donnée "Feu orange Arrivée" du fichier matrice est renseignée alors on met la date du fichier du jour dans la case Ix du fichier matrice
            If Not resultat Is Nothing And feujour = "Feu vert Arrivée" And feuveille = "Feu orange Arrivée" Then
            Set dateorange = Sheets(nomonglet2).Cells(resultat.Row, 8) 'on récupère la valeur de la case H4 à H"fin"
            Set datevert = Sheets(nomonglet2).Cells(resultat.Row, 9) 'on récupère la valeur de la case I4 à I"fin"
            Windows("" & fichier2 & ".xls").Activate
            Range("I" & resultat.Row).Select
            Range("I" & resultat.Row).Value = Format(Now - 1, "dd/mm/yyyy")
            Range("I" & resultat.Row).Value = datewb
            Range("G" & resultat.Row).Select
            Range("G" & resultat.Row).Value = feujour
            End If

        End If

    Windows(MyFiles(j)).Activate

    Next i 'on passe à la prochaine itération

    Application.DisplayAlerts = False
    Windows(MyFiles(j)).Activate
    ActiveWindow.Close

Next j

'Windows("" & fichier & ".xls").Activate
'ActiveWindow.Close 'on clôture le fichier du jour sans enregistrer

Windows("" & fichier2 & ".xls").Activate
ActiveWorkbook.Save
ActiveWindow.Close 'on enregistre et clôture le fichier matrice

End Sub