Synthèse de données

Sub Test()
'
' Test Macro
' Etabli la synthèse de concordance entre les services de Géo 2 et 3,
'
' Touche de raccourci du clavier: Ctrl+y
'
Dim nom As Integer, tachesNouvelles As Integer, tacheAncienne As Range, i As Integer, flagCap As Boolean
Dim colTache As Range, ligneNom As Range, estCapable As Integer, firstAddress As String, noLigne As Integer


For nom = 26 To ThisWorkbook.Sheets("Distribution2").Cells(ThisWorkbook.Sheets("Distribution2").Rows.Count, 4).End(xlUp).Row
    If ThisWorkbook.Sheets("Distribution2").Range("D" & nom).Value <> vbNullString Then
        For tachesNouvelles = 10 To 109
            estCapable = 1
            Set tacheAncienne = ThisWorkbook.Sheets("Distribution2").Cells(10, tachesNouvelles)
            With ThisWorkbook.Sheets("Distribution")
                While tacheAncienne.Row < 26
                    If tacheAncienne.Value <> vbNullString Then
                        Set colTache = .Rows(9).Find(what:=tacheAncienne.Value, LookIn:=xlValues, lookat:=xlWhole)
                        Set ligneNom = .Columns(4).Find(what:=ThisWorkbook.Sheets("Distribution2").Range("D" & nom).Value, LookIn:=xlValues, lookat:=xlWhole)
                        If ligneNom Is Nothing Then
                            estCapable = 0
                        Else
                            firstAddress = ligneNom.Address
                            noLigne = 0
                            Do
                                If ligneNom.Offset(0, 3).Value = ThisWorkbook.Sheets("Distribution2").Range("G" & nom).Value Then noLigne = ligneNom.Row
                                Set ligneNom = .Columns(4).FindNext(ligneNom)
                            Loop Until ligneNom.Address = firstAddress
                            If noLigne = 0 Then
                                estCapable = 0
                            Else
                                If Not colTache Is Nothing Then
                                    estCapable = estCapable * IIf(.Cells(noLigne, colTache.Column).Value = 1, 1, 0)
                                End If
                            End If
                        End If
                    End If
                    Set tacheAncienne = tacheAncienne.Offset(1, 0)
                Wend
            End With
            flagCap = False
            For i = 10 To 25
                If ThisWorkbook.Sheets("Distribution2").Cells(i, tachesNouvelles).Value <> vbNullString Then flagCap = True
            Next i
            If Not flagCap Then estCapable = 0
            ThisWorkbook.Sheets("Distribution2").Cells(nom, tachesNouvelles).Value = IIf(estCapable = 1, 1, "")
        Next tachesNouvelles
    End If
Next nom
End Sub