DefInt A-Z ' code plus rapide mais avec moins de 32768 lignes !
Private Sub ButtonTransfert_Click()
Dim Departement As Range, Rang As Range
Application.ScreenUpdating = False
Sheets("Destination").UsedRange.Offset(1).Clear
NoDeLigDestin = 1
' boucle dans source 2
For Each Departement In Sheets("Source 2").UsedRange.Columns(1).Offset(1).Cells
' recherche le département de la source 2 dans source 1
Set Rang = Sheets("Source 1").UsedRange.Columns(1).Offset(1).Find(Departement)
If Not Rang Is Nothing Then
NoDeLigDestin = NoDeLigDestin + 1 'copie ligne source 1 > destin
Sheets("Source 1").Rows(Rang.Row).Copy Destination:=Sheets("Destination").Rows(NoDeLigDestin)
Sheets("Source 1").Rows(Rang.Row).EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
End Sub