Bonjour le forum,
Pourriez vous me donner un coup de main svp?
J'ai créé une macro qui permet de supprimer les doublons dans une base de données.
- Elle copie la base de données de la feuille(ZA), la copie dans la feuille (DB), puis fais supprime les doublons dans cette dernière.
Problème:Je n'arrive qu'à l’exécuter à partir de la feuille (DB). Je voudrais en effet l'exécuter à partir d'un bouton de commande contenu sur une autre feuille (Menu).
Ci après mon code. Merci d'avance
Sub Registerbd()
Dim c As Range, i As Integer
Dlg = Sheets("ZA").Range("A" & Rows.Count).End(xlUp).Row
Set c = Sheets("ZA").Range("B2:F" & Dlg)
c.Copy
With ThisWorkbook.Sheets("BD")
ThisWorkbook.Sheets("BD").[A2].Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set MonDico = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
i = 2
Do While ThisWorkbook.Sheets("BD").Cells(i, "A") <> ""
If Not MonDico.Exists(Cells(i, "A") & Cells(i, "E")) Then
MonDico(Cells(i, "A") & Cells(i, "E")) = ""
i = i + 1
Else
ThisWorkbook.Sheets("BD").Rows(i).EntireRow.Delete
End If
Loop
End With
End Sub
Pourriez vous me donner un coup de main svp?
J'ai créé une macro qui permet de supprimer les doublons dans une base de données.
- Elle copie la base de données de la feuille(ZA), la copie dans la feuille (DB), puis fais supprime les doublons dans cette dernière.
Problème:Je n'arrive qu'à l’exécuter à partir de la feuille (DB). Je voudrais en effet l'exécuter à partir d'un bouton de commande contenu sur une autre feuille (Menu).
Ci après mon code. Merci d'avance
Sub Registerbd()
Dim c As Range, i As Integer
Dlg = Sheets("ZA").Range("A" & Rows.Count).End(xlUp).Row
Set c = Sheets("ZA").Range("B2:F" & Dlg)
c.Copy
With ThisWorkbook.Sheets("BD")
ThisWorkbook.Sheets("BD").[A2].Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set MonDico = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
i = 2
Do While ThisWorkbook.Sheets("BD").Cells(i, "A") <> ""
If Not MonDico.Exists(Cells(i, "A") & Cells(i, "E")) Then
MonDico(Cells(i, "A") & Cells(i, "E")) = ""
i = i + 1
Else
ThisWorkbook.Sheets("BD").Rows(i).EntireRow.Delete
End If
Loop
End With
End Sub