View original (French)

Compare 2 excel sheets [VBA]

Solved
binos359 Posted messages 2 Status Member -  
binos359 Posted messages 2 Status Member -
```vba
Sub comparerFeuilles()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim wsCopy As Worksheet
Dim lastRow1 As Long
Dim lastRow2 As Long
Dim i As Long
Dim j As Long
Dim found As Boolean
Dim copyRow As Long

Set ws1 = ThisWorkbook.Sheets("Feuille1") ' Remplacez par le nom de votre première feuille
Set ws2 = ThisWorkbook.Sheets("Feuille2") ' Remplacez par le nom de votre deuxième feuille
Set wsCopy = ThisWorkbook.Sheets("FeuilleCopy") ' Remplacez par le nom de la feuille où vous copiez les lignes

lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
copyRow = 1

' Supprimer les lignes de ws1 qui ne sont pas dans ws2
For i = lastRow1 To 1 Step -1
found = False
For j = 1 To lastRow2
If ws1.Cells(i, 1).Value = ws2.Cells(j, 1).Value Then
found = True
Exit For
End If
Next j
If Not found Then
ws1.Rows(i).Delete
End If
Next i

' Copier les lignes de ws2 qui ne sont pas dans ws1
For i = 1 To lastRow2
found = False
For j = 1 To lastRow1
If ws2.Cells(i, 1).Value = ws1.Cells(j, 1).Value Then
found = True
Exit For
End If
Next j
If Not found Then
wsCopy.Rows(copyRow).Value = ws2.Rows(i).Value
copyRow = copyRow + 1
End If
Next i

End Sub
```

2 answers

Answer 1 / 2
cs_Le Pivert Posted messages 8437 Status Contributor 730
 
Hello,

The code you found online compares 2 columns located on the same sheet

Here is an example with 2 columns located in 2 sheets to adapt:

Put in a UserForm 5 buttons with this code: 

Option Explicit Dim der_ligne, cel1, cel2, li 'color duplicates Private Sub CommandButton1_Click() der_ligne = Range("A" & "65000").End(xlUp).Row For Each cel1 In Sheets("Sheet1").Range("A1:A" & der_ligne) For Each cel2 In Sheets("Sheet2").Range("A1:A" & der_ligne) If cel1 = cel2 Then li = li + 1 cel1.Interior.ColorIndex = 3 cel2.Interior.ColorIndex = 3 End If Next Next End Sub 'restore original color Private Sub CommandButton2_Click() der_ligne = Range("A" & "65000").End(xlUp).Row Sheets("Sheet1").Range("A1:A" & der_ligne).Interior.ColorIndex = xlNone Sheets("Sheet2").Range("A1:A" & der_ligne).Interior.ColorIndex = xlNone End Sub 'delete duplicate content in sheet2 Private Sub CommandButton3_Click() der_ligne = Range("A" & "65000").End(xlUp).Row For Each cel1 In Sheets("Sheet1").Range("A1:A" & der_ligne) For Each cel2 In Sheets("Sheet2").Range("A1:A" & der_ligne) If cel1 = cel2 Then li = li + 1 cel2.ClearContents End If Next Next End Sub 'copy rows without duplicates to sheet3 Private Sub CommandButton4_Click() der_ligne = Range("A" & "65000").End(xlUp).Row For Each cel1 In Sheets("Sheet1").Range("A1:A" & der_ligne) For Each cel2 In Sheets("Sheet2").Range("A1:A" & der_ligne) If cel1 = cel2 Then li = li + 1 cel1.Interior.ColorIndex = 3 End If Next Next li = 0 For Each cel1 In Sheets("Sheet1").Range("A1:A" & der_ligne) If cel1.Interior.ColorIndex = xlNone Then li = li + 1 Sheets("Sheet3").Select Range("A" & li).Value = cel1 End If Next Sheets("Sheet1").Range("A1:A" & der_ligne).Interior.ColorIndex = xlNone End Sub 'delete duplicate row in sheet2 Private Sub CommandButton5_Click() der_ligne = Range("A" & "65000").End(xlUp).Row For Each cel1 In Sheets("Sheet1").Range("A1:A" & der_ligne) For Each cel2 In Sheets("Sheet2").Range("A1:A" & der_ligne) If cel1 = cel2 Then li = li + 1 cel2.Delete End If Next Next End Sub Private Sub UserForm_Initialize() CommandButton1.Caption = "Color duplicates" CommandButton2.Caption = "Restore colors" CommandButton3.Caption = "Delete rows" CommandButton4.Caption = "Copy rows" CommandButton5.Caption = "Delete rows" End Sub


You can adapt inputBox with the codes that are in the buttons by making macros

--
@+ The Woodpecker
0