Bonjour
Une dernière chose à tester, c'est de passer en calcul manuel en début de macro
Voir ce que cela donne avec cette macro modifiée dans ce sens
Option Explicit
Sub cles_test()
Dim Cle1 As String
Dim Rng1 As Range
Dim Gpn As String
Dim I As Integer
Dim ModeCalcul As Integer
Gpn = "_GPN_"
Sheets("A3").Activate
With Application
.ScreenUpdating = False
ModeCalcul = .Calculation
.Calculation = xlCalculationManual
End With
With Sheets("A7")
For I = 2 To 4
If IsNumeric(Cells(I, 1)) Then
Cle1 = Cells(I, 26) & Gpn & Cells(I, 1)
If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
End If
If Not IsError(Cells(I, 2)) Then
Cle1 = Cells(I, 26) & Cells(I, 2)
If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
End If
If Not IsError(Cells(I, 3)) Then
Cle1 = Cells(I, 26) & Gpn & Cells(I, 3)
If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
End If
If Not IsError(Cells(I, 4)) Then
Cle1 = Cells(I, 26) & Gpn & Cells(I, 4)
If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
End If
If Not IsError(Cells(I, 9)) Then
Cle1 = Cells(I, 26) & Gpn & Cells(I, 9)
If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
End If
If Not IsError(Cells(I, 10)) Then
Cle1 = Cells(I, 26) & Cells(I, 10)
If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
End If
If Not IsError(Cells(I, 25)) Then
Cle1 = Cells(I, 26) & Cells(I, 25)
If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1: GoTo Suite
End If
If Not IsError(Left(Cells(I, 18), 5)) Then
Cle1 = Cells(I, 26) & Left(Cells(I, 18), 5)
If Application.CountIf(.Range("B:B"), Cle1) > 0 Then Cells(I, 32) = Cle1
End If
Suite:
Next I
End With
Application.Calculation = ModeCalcul
End Sub