Définir une plage de feuille VBA

Option Explicit  
Option Base 1  
Const Dercol As Integer = 8 'n° de la dernière colonne utilisée  

Sub alter_reference()  
Dim Derlig1 As Long, Derlig2 As Long  
Dim Cptr As Integer, T1_colb(), T2_colb  
Dim Dico1 As Object, Dico2 As Object  
Dim T_out(), Nbre As Long, Col As Byte  
Dim Start As Single, Duree As Single 'pour essai rapidité  

Start = Timer  

'fige le défilement de l'écran  
Application.ScreenUpdating = False  

'ipréparations feuil1  
With Sheets("feuil1")  
     Derlig1 = .Cells(.Rows.Count, 2).End(xlUp).Row  
     'passage en ram tableau feuille1  
     T1_colb = .Range(.Cells(1, 1), .Cells(Derlig1, Dercol)).Value  
     'création du dictionnary feuille1 col b  
     Set Dico1 = CreateObject("scripting.dictionary")  
          For Cptr = 1 To UBound(T1_colb)  
               If Not Dico1.exists(T1_colb(Cptr, 2)) Then 'élimination des éventuels doublons  
                    Dico1.Add T1_colb(Cptr, 2), ""  
               End If  
          Next  
End With  

With Sheets("feuil2")  
'initialisations et préparations feuil2  
     Derlig2 = .Cells(.Rows.Count, 2).End(xlUp).Row  
     .Range(.Cells(1, 1), .Cells(Derlig2, Dercol)).Interior.ColorIndex = xlNone  
     'passage en ram tableau feuil2  
     T2_colb = .Range(.Cells(1, 1), .Cells(Derlig2, Dercol)).Value  
     'création du dictionnary feuille1 col b  
     Set Dico2 = CreateObject("scripting.dictionary")  
          For Cptr = 1 To UBound(T2_colb)  
                If Not Dico2.exists(T2_colb(Cptr, 2)) Then 'élimination des éventuels doublons  
                    Dico2.Add T2_colb(Cptr, 2), ""  
               End If  
          Next  
     
'détecte les éléments de feuil2 manquant en feuil1 _  
     et les colorise en jaune  
     For Cptr = 1 To UBound(T2_colb)  
          If Not Dico1.exists(T2_colb(Cptr, 2)) Then  
               .Range(.Cells(Cptr, 1), .Cells(Cptr, Dercol)).Interior.ColorIndex = 6  
          End If  
     Next  

'mémorise les éléments de feuil1 manquant en feuil2 _  
     et les retranscrit  dans la feuille 2 et les colorise en rouge  
     Nbre = 1  
     ReDim T_out(Dercol, Nbre)  
     'mémorisation  
     For Cptr = 1 To UBound(T1_colb)  
          If Not Dico2.exists(T1_colb(Cptr, 2)) Then  
               For Col = 1 To Dercol  
                    T_out(Col, Nbre) = T1_colb(Cptr, Col)  
               Next  
               Nbre = Nbre + 1  
               ReDim Preserve T_out(Dercol, Nbre)  
          End If  
     Next  
     ReDim Preserve T_out(Dercol, Nbre - 1) 
  'restitution  
     With .Cells(Derlig2 + 1, 1).Resize(Nbre - 1, Dercol)  
          .Value = Application.Transpose(T_out)  
          .Interior.ColorIndex = 3  
     End With  
     .Activate  
End With  

'pour essai  
Duree = Timer - Start  
Application.ScreenUpdating = False  
MsgBox ("durée: " & Duree & " secondes")  

End Sub  

Sub Reference()

    Dim PlageFE_1 As Range
    Dim PlageFE_2 As Range
    Dim CelFE_1 As Range
    Dim CelFE_2 As Range
    Dim DerCel As Long
    
    'défini les plages en colonne B de Feuil1 et Feuil2
    With Worksheets("Feuil1")
    
        Set PlageFE_1 = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp))
    
    End With
    
    With Worksheets("Feuil2")
    
        Set PlageFE_2 = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp))
        
        'mémorise la dernière ligne occupée
        DerCel = .Cells(.Rows.Count, 2).End(xlUp).Row
        
    End With
    
    'boucle sur la plage en Feuil1 et recherche la valeur en Feuil2
    'si pas trouvée, rajoute la ligne à Feuil2 puis colore (cellules non vides) en rouge
    For Each CelFE_1 In PlageFE_1
    
        Set CelFE_2 = PlageFE_2.Find(CelFE_1, , xlValues, xlWhole)
        
        If CelFE_2 Is Nothing Then
        
            DerCel = DerCel + 1
            
            With Worksheets("Feuil2")
            
                CelFE_1.EntireRow.Copy .Range("A" & DerCel)
                .Range(.Cells(DerCel, 2), .Cells(DerCel, .Columns.Count).End(xlToLeft)).Interior.ColorIndex = 3
                
            End With
            
        End If
        
    Next CelFE_1
    
    'boucle sur la plage en Feuil2 et recherche la valeur en Feuil1
    'si pas trouvée, colore la ligne (cellules non vides) en jaune
    For Each CelFE_2 In PlageFE_2
    
        Set CelFE_1 = PlageFE_1.Find(CelFE_2, , xlValues, xlWhole)
        
        If CelFE_1 Is Nothing Then
        
            With Worksheets("Feuil2")
            
                .Range(.Cells(CelFE_2.Row, 2), .Cells(CelFE_2.Row, .Columns.Count).End(xlToLeft)).Interior.ColorIndex = 6
                
            End With
            
        End If
        
    Next CelFE_2

End Sub

Sub AUTRE()  
Dercel1 = Feuil1.Cells(Rows.Count, 2).End(xlUp).Row  
DerCel2 = Feuil2.Cells(Rows.Count, 2).End(xlUp).Row  
For Ligne1 = 2 To Dercel1  
    Feuil1.Cells(Ligne1, 10) = 1  
    Feuil1.Cells(Ligne1, 11) = Ligne1  
Next Ligne1  
For Ligne2 = 2 To DerCel2  
    Feuil2.Cells(Ligne2, 10) = 2  
    Feuil2.Cells(Ligne2, 11) = Ligne2  
Next Ligne2  

Sheets("Feuil1").Select  
Rows(2 & ":" & Dercel1).Select  
Selection.Copy  
Sheets("Feuil3").Select  
Rows("1:1").Select  
ActiveSheet.Paste  

Sheets("Feuil2").Select  
Rows(2 & ":" & DerCel2).Select  
Selection.Copy  
Sheets("Feuil3").Select  
Rows(Dercel1).Select  
ActiveSheet.Paste  
' on trie la feuille3  
With ActiveWorkbook.Worksheets("Feuil3").Sort  
    .SetRange Range("A1:K" & Dercel1 + DerCel2 - 2)  
    .MatchCase = False  
    .Orientation = xlTopToBottom  
    .SortMethod = xlPinYin  
    .Apply  
End With  
' on enlève les doublons  
For Ligne = Dercel1 + DerCel2 - 2 To 2 Step -1  
    If Cells(Ligne, 2) = Cells(Ligne - 1, 2) Then  
        Rows(Ligne & ":" & Ligne - 1).Select  
        Selection.Delete Shift:=xlUp  
    End If  
Next Ligne  
' toutes les lignes avec 1 en colonne 10 sont celles présentes en feuil1 et pas en feuil2  
' Toutes celles avec 2 c'est le contraire  
Derligne = Feuil3.Cells(Rows.Count, 2).End(xlUp).Row  
For Ligne = 1 To Derligne  
    If Cells(Ligne, 10) = 1 Then  
        DerCel2 = DerCel2 + 1  
        Ligne1 = Cells(Ligne, 11)  
        With Worksheets("Feuil2")  
            Feuil1.Cells(Ligne1, 1).EntireRow.Copy .Range("A" & DerCel2)  
            .Range(.Cells(DerCel2, 2), .Cells(DerCel2, .Columns.Count).End(xlToLeft)).Interior.ColorIndex = 3  
        End With  
    ElseIf Cells(Ligne, 10) = 2 Then  
        Ligne2 = Cells(Ligne, 11)  
        With Worksheets("Feuil2")  
            .Range(.Cells(Ligne2, 2), .Cells(Ligne2, .Columns.Count).End(xlToLeft)).Interior.ColorIndex = 6  
        End With  
    End If  
Next Ligne  
End Sub