Mettre en évidence des similitudes entre 2 colonnes Excel [VBA]

Private Sub CommandButton1_Click()

'INITIALISATION

Dim i As Long ' Lignes de la colonne B
Dim j As Long ' Colonne A à Colonne P
Dim k As Long ' Lignes de la colonne R
Dim m As Long ' Changment de couleur
Dim reference As String ' Stockage de la référence
Dim n As Long
Application.ScreenUpdating = False
' PROGRAMME

m = 0
For k = 3 To [R65536].End(xlUp).Row  ' Parcours la colonne R
    For i = 3 To [B65536].End(xlUp).Row  ' Parcours des données recensées à l'exception  des cellules non remplies
        If Cells(k, 18).Value = Cells(i, 2).Value And Cells(i, 2).Value <> "" And Cells(k, 18).Value <> "" Then 'Recherche des similitudes en évitant les cellules vides ..
            m = m + 1
            Worksheets(1).Range(Cells(i, 1), Cells(i, 16)).Interior.ColorIndex = m
            Cells(k, 18).Interior.ColorIndex = m
            reference = Cells(k, 18).Value ' Le but est d'attribuer une couleur par référence //  Stockage de la chaine
            i = i + 1
                    For n = i To [B65536].End(xlUp).Row ' Parcours de la colonne B à partir de la référence qui suit la référence trouvée
                        If Cells(i, 2).Value = reference Then
                            Worksheets(1).Range(Cells(i, 1), Cells(i, 16)).Interior.ColorIndex = m
                        End If
                    Next n
        End If
    Next i
Next k
Application.ScreenUpdating = True

End Sub

Private Sub CommandButton1_Click()

'INITIALISATION

Dim i As Long ' Lignes de la colonne B
Dim j As Long ' Colonne A à Colonne P
Dim k As Long ' Lignes de la colonne R
Dim m As Long ' Changment de couleur
Dim reference As String ' Stockage de la référence
Dim n As Long
Application.ScreenUpdating = False
' PROGRAMME

m = 0
For k = 3 To [R65536].End(xlUp).Row  ' Parcours la colonne R
    For i = 3 To [B65536].End(xlUp).Row  ' Parcours des données recensées à l'exception  des cellules non remplies
        If Cells(k, 18).Value = Cells(i, 2).Value And Cells(i, 2).Value <> "" And Cells(k, 18).Value <> "" Then 'Recherche des similitudes en évitant les cellules vides ..
            m = m + 1
            Worksheets(1).Range(Cells(i, 1), Cells(i, 16)).Interior.ColorIndex = m
            Cells(k, 18).Interior.ColorIndex = m
            reference = Cells(k, 18).Value ' Le but est d'attribuer une couleur par référence //  Stockage de la chaine
            i = i + 1
                    For n = i To [B65536].End(xlUp).Row ' Parcours de la colonne B à partir de la référence qui suit la référence trouvée
                        If Cells(i, 2).Value = reference Then
                            Worksheets(1).Range(Cells(i, 1), Cells(i, 16)).Interior.ColorIndex = m
                        End If
                    Next n
        End If
    Next i
Next k
Application.ScreenUpdating = True

End Sub

Private Sub CommandButton7_Click()

'INITIALISATION
Dim i As Long
Dim j As Long

'PROGRAMME

' Supprime les "x" des cellules de la colonne Q: utilisé pour les filtres
For i = 13 To [Q65536].End(xlUp).Row
    Cells(i, 17).Value = ""
Next i
 
 ' Supprime les références de Barthe de la colonne R
For j = 13 To [R65536].End(xlUp).Row
    Cells(j, 18).Value = ""
Next j
 
 ' Réinitialise le format des cellules lorsqu'elles ont étaient trouvées après une recherche
Worksheets(1).Range(Cells(8, 1), Cells(20000, 50)).Interior.ColorIndex = 0
   
 ' Sauvegarde le fichier
 reference -documentaire - test.Save
 ' Ferme le fichier
Application.Quit

End Sub

'======================================================================
'Permet de sauvegarder et quitter le classeur.
'======================================================================
Sub saveAndQuit(Cancel As Boolean)
For Each w In Application.Workbooks
w.Save
Next w
ThisWorkbook.Close
End Sub

 j=1
For i = 13 to [Q65536].End(xlUp).Row
 If Cells(i,17).Value = "x" then
'Copier la plage de cellule(Ai:Pi) dans la feuille 2 sur la plage (Aj:Pj) 
j = j + 1
End for

' Et finir par une instruction nous dirigeant directiment en feuille 2

Sub CopierColler()
Dim i&
Z = 1
 LigneFeuille1 = 2
    Sheets("TA_FEUILLE_DORIGINE").Select
    
      For i = 0 To [I65536].End(xlUp).Row
        
        If Range("i2").Offset(i, 0).Value = "x" Then
            Range("i2").Offset(i, 0).EntireRow.Copy
            Sheets("TA_FEUILLE_DE_DESTINATION").Select
            Cells(LigneFeuille1, 1).EntireRow.Insert Shift:=xlDown
            Sheets("TA_FEUILLE_DORIGINE").Select
            Z = Z + 1
        End If
End Sub