Optimiser des boucles

Bonjour à tous,

J'ai créé une macro rapatriant des données de sociétés. Elle fonctionne, mais elle est malheureusement beaucoup trop lente. Avez-vous quelques idées pour l'optimiser ?

Le ficher comprend deux feuilles :
- La première est une liste d'environ 1000 noms de société ayant fait faillite à laquelle est attaché un numéro d'identification (la feuille wsModel).
- La seconde est une liste de données correspondant à ces sociétés d'approximativement 10 000 lignes (la feuille wsAbar).

Pour chaque société de la première feuille (la feuille wsModel), la macro va insérer une donnée provenant de la deuxième feuille (wsAbar).

Le collage s'effectue de la façon suivante :
- L'objectif de la macro est de voir quelle était la situation financière de la société avant qu'elle fasse faillite. L'utilisateur peut sélectionner différentes données,(Financial metric) que la macro va aller chercher puis coller dans la bonne cellule de la première feuille wsModel.
- Chaque société fait faillite à des dates différentes. En plus, chaque société publie des données à des dates différentes (oui, la base de données est un peu foutraque). Du coup, la macro va regarder la date de la faillite et la date de publication de la donnée pour la coller au bon endroit dans le tableau.

Vous trouverez ci-dessous une version simplifiée du code. Avez-vous une idée de ce qui doit être changé pour qu'il tourne plus vite ?

Merci beaucoup pour votre aide !

Code:

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
Option Explicit
 
Sub Defaults()
 
Application.ScreenUpdating = False
 
Application.Calculation = xlManual
 
'VARIABLE DEFINITIONS
 
'Worksheets
 
Dim wsModel As Worksheet 'Sheet Model
Set wsModel = Sheets("Model")
 
Dim wsAbar As Worksheet 'Sheet Arrowbar
Set wsAbar = Sheets("Data retrieval (dest.)")
 
'Variables defined in loops
 
Dim lgCoreIDValueModel As Long 'Core ID number of the sheet wsModel
Dim lgCoreIDValueAbar As Long 'Core ID number of the sheet wsAbar
Dim dtDefault As Date
Dim dtClosing As Date
Dim dtDifference As Long
 
Dim lgModelRow As Long 'Row number of the Model sheet
Dim lgAbarRow As Long 'Row number of the Arrowbar sheet
 
Dim lgAbarData As Long 'Data of the Arrowbar sheet to be pasted in the sheet model
 
'Financial metrics
 
Dim sgFinancialMetricAnnual As String 'Text field of the annual financial metric in the Model sheet
sgFinancialMetricAnnual = Range("FinancialMetricAnnual")
 
Dim btFinancialMetricAnnualColumnAbar As Byte 'Corresponding colum number in the sheet wsAbar
btFinancialMetricAnnualColumnAbar = wsAbar.Cells.Find(What:=sgFinancialMetricAnnual, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Column
 
'Variables from sheet wsModel
 
    'Column numbers
 
        'Core ID
 
Dim btCoreIDColumnModel As Byte
btCoreIDColumnModel = Range("CoreIDModel").Column
 
        'Default date
 
Dim btDefaultDateColumnModel As Byte
btDefaultDateColumnModel = Range("DefaultDateModel").Column
 
        'Value at default
 
Dim btDefaultValueColumnModel As Byte
btDefaultValueColumnModel = Range("DefaultModel").Column
 
'Variables from sheet wsAbar
 
    'Core ID column
 
Dim btCoreIDColumnAbar As Byte
btCoreIDColumnAbar = wsAbar.Cells.Find(What:="Core ID", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Column
 
    'Closing date
 
Dim btClosingDateColumnAbar As Byte 'Column number of the field "Financial Period End Date" in the sheet Arrowbar
btClosingDateColumnAbar = wsAbar.Cells.Find(What:="Financial Period End Date", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Column
 
'DATA RETRIEVAL
 
'Deleting previous data
 
wsModel.Range("BA101:CO10000").Delete
 
'In sheet wsModel
 
For lgModelRow = 100 To 103
 
lgCoreIDValueModel = wsModel.Cells(lgModelRow, btCoreIDColumnModel) 'Find Core ID
 
If lgCoreIDValueModel > 0 Then 'Retrieve data only if the Core ID is populated
 
'If IsDate(wsModel.Cells(lgModelRow, btDefaultDateColumnModel)) = True Then 'Find default year, set to zero if it's not a date
dtDefault = wsModel.Cells(lgModelRow, btDefaultDateColumnModel)
'Else
'dtDefault = "01/01/1900"
'End If
 
 
'PASTE DATA
 
For lgAbarRow = 4 To 61
 
lgCoreIDValueAbar = wsAbar.Cells(lgAbarRow, btCoreIDColumnAbar) 'Find Core ID
 
dtClosing = wsAbar.Cells(lgAbarRow, btClosingDateColumnAbar)
 
'Insert data from the sheet Arrowbar to the sheet model
 
If lgCoreIDValueModel = lgCoreIDValueAbar Then
 
dtDifference = Round((dtDefault - dtClosing) / 91, 0) 'Calculate number of quarters between the closing date and the default date
 
If dtDifference <= 20 And dtDifference >= -20 Then 'Paste data only for up to five years before and after default
 
'Paste data
 
lgAbarData = wsAbar.Cells(lgAbarRow, btFinancialMetricAnnualColumnAbar)
wsModel.Cells(lgModelRow, btDefaultValueColumnModel - dtDifference) = lgAbarData
 
End If 'Close End if checking that the data pasted is only for up to five years before and after default
 
End If 'Close End if checking that the Core ID is populated
 
Next lgAbarRow
 
'NEXT ROW IN THE SHEET lgModelRow
 
End If 'End of the loop activated if the Core ID is populated
 
Next lgModelRow
 
'DEFAULT EXCEL SETTINGS
 
Application.ScreenUpdating = True
 
Application.Calculation = xlSemiautomatic
 
 
End Sub