XL 2019 AIDE SUR UNE PREMIÈRE MACRO

[lycan54]

Bonjour à tous,

je cherche de l'aide pour améliorer la macro qui suit
je dois détecter les doublons dans divers fichiers que j e place dans un seul classeur
je dois l’enregistrer pour garder trace de ce contrôle
j’aimerai insérer des boutons d'actions sur la feuille deux du fichier et retrouver la synthèse en feuille 1 ou l'inverse

merci d'avance pour votre aide

ci desous le code en question

Private Sub CommandButton1_Click()

' Boucle sur chaque Feuille (Sauf la première qui est Synthese)
For i = 3 To Sheets.Count

Sheets(i).AutoFilterMode = False ' Suppression de tyout Filtre
Sheets(i).Rows("5:5").AutoFilter Field:=1, Criteria1:="<>" ' Filtre sur la première colonne différent de vide
Sheets(i).Rows("1:" & Sheets(i).Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy 'Copie

LigneCollage = Sheets("Synthese").Range("A" & Rows.Count).End(xlUp).Row + 0 'Rechercher de la ligne de collage
If LigneCollage < 1 Then LigneCollage = 1

Sheets("Synthese").Range("A" & LigneCollage).PasteSpecial 'Collage
Application.CutCopyMode = False
Sheets(i).AutoFilterMode = False ' Suppression de tout Filtre

Next i

End Sub
Private Sub CommandButton2_Click()
Dim i As Integer
For i = [A65000].End(xlUp).Row To 1 Step -1
If Not Cells(i, 1).Find("Total") Is Nothing Or _
Not Cells(i, 1).Find("Dénomination Professionnel") Is Nothing Or _
Not Cells(i, 1).Find("test") Is Nothing Then Rows(i).Delete
Next i
End Sub
Private Sub CommandButton3_Click()
'ConcatColumns
For i = 1 To 10
Cells(1, 11) = Cells(1, 11) & "" & Cells(1, i)
Next i
End Sub
Sub Macro1()
Selection.AutoFill Destination:=ActiveCell.Range("A1:A182")
ActiveCell.Range("A1:A182").Select
End Sub
Sub RechercherDoublons()

Dim col, nbCells, i, j

col = ActiveCell.Column

nbCells = Application.WorksheetFunction.CountA(Range(Columns(col), Columns(col)))

For i = 1 To nbCells - 1

For j = i + 1 To nbCells

If Cells(i, col) = Cells(j, col) Then

Cells(j, col).Interior.Color = RGB(255, 0, 0)

End If

Next j

Next i

End Sub



Private Sub Macro5_Click()

'

'
ActiveCell.FormulaR1C1 = "=+IF(COUNTIF(C[-1],RC[-1])>1,""doublon"",""ras"")"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A182")
ActiveCell.Range("A1:A182").Select
ActiveCell.Select
Selection.AutoFilter
Selection.AutoFilter
ActiveSheet.Range("$A$1:$L$182").AutoFilter Field:=12, Criteria1:= _
"=doublon", Operator:=xlAnd
End Sub
Sub sauvegarder()

ChDir "h:\Dossier\"
ActiveWorkbook.SaveAs Filename:=Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")

End Sub