Bonjour à tous, je souhaite optimiser un code VBA qui ajoute des données et met à jour le fichier excel à partir d'un autre fichier excel extrait d'un logiciel.

J'ai optimisé comme j'ai pu certaines fonctions mais ces deux suivantes me mènent la vie dure..

La fonction add() qui va chercher les nouvelles données dans le fichier extract pour les ajouter.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub add()
 
Dim a, c, i, j, iRC, k, y As Boolean
Dim WbC As Workbook
 
Set WbC = ThisWorkbook
c = WbC.Sheets("Incidents").Range("A1").CurrentRegion.Value
iRC = UBound(c) + 1
Workbooks.Open Filename:= _
    "fichierextract.xls"
a = ActiveWorkbook.Sheets("DATA").Range("A1").CurrentRegion.Value
ActiveWorkbook.Close
With WbC.Sheets("Incidents")
 For i = 2 To UBound(a)
   For j = 2 To UBound(c)
            If c(j, 5) = a(i, 5) Then
                y = True
            End If
        Next j
         If Not y Then
             For k = 1 To 17
             Cells(iRC, k) = a(i, k)
             Next
                iRC = iRC + 1
          End If
          y = False
    Next i
End With
'MsgBox "L'ajout des nouveaux incidents est terminé !"
End Sub
La fonction update() qui va vérifier que tout soit a jour.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub update()
Application.ScreenUpdating = False
LISTE = ActiveWorkbook.Name
Workbooks.Open Filename:= _
            "fichierextract.xls"   ' Le chemin du fichier
IWS = ActiveWorkbook.Name
LastrowC = Workbooks(LISTE).Sheets("Incidents").Cells.Find("*", ActiveSheet.Range("A1"), , , xlByRows, xlPrevious).Row
LastrowI = Workbooks(IWS).Sheets("DATA").Cells.Find("*", ActiveSheet.Range("A1"), , , xlByRows, xlPrevious).Row
 
Dim sheetSource As Worksheet
Dim sheetDest As Worksheet
 
Set sheetSource = Workbooks(IWS).Sheets("DATA")
Set sheetDest = Workbooks(LISTE).Sheets("Incidents")
 
 For i = 2 To LastrowC
        For j = 2 To LastrowI
            If sheetDest.Cells(i, 5) = sheetSource.Cells(j, 5) Then
                        sheetDest.Cells(i, 7) = sheetSource.Cells(j, 7)
                        sheetDest.Cells(i, 9) = sheetSource.Cells(j, 9)
                        sheetDest.Cells(i, 13) = sheetSource.Cells(j, 13)
                        sheetDest.Cells(i, 14) = sheetSource.Cells(j, 14)
                        sheetDest.Cells(i, 15) = sheetSource.Cells(j, 15)
                        sheetDest.Cells(i, 17) = sheetSource.Cells(j, 17)
            End If
        Next j
    Next i
'MsgBox "La mise à jour des données liées aux incidents est terminée !!!!"
Workbooks(IWS).Close False
Application.ScreenUpdating = True
End Sub
Pouvez-vous me donner des pistes sur l'optimisation de ce code , qui peut mettre plusieurs heures s'il y a 20 nouveaux incidents à rajouter et mettre à jour..

Merci d'avance.