XL 2013 copier/coller puis supprimer les doublons VBA

jpg21

XLDnaute Nouveau
Bonjour,

Je suis nul en VBA.
je désire pouvoir ajouter les valeurs de la colonne A (zone de collage) dans la colonne B (réception) puis supprimer les doublons de la colonne B.
J ai trouver pour supprimer les doublons,
J ai trouver pour faire le copier /coller mais je n arrive pas combiner les 2

Merci de votre aide

Cordialement

JPg21
 

Pièces jointes

  • essai1.xlsm
    47.2 KB · Affichages: 7

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour JPG,
Un essai en PJ :
VB:
Sub SansDoublonsTrié2()
    Application.ScreenUpdating = False                              ' Fige écran
    Set f = Sheets("tableau").[A65000].End(xlUp)                    ' Définit plage A
    Range("B5:B" & f) = Range("A5:A" & f).Value                     ' Tranfert valeurs
    Set f = Sheets("tableau").Range("B5:B" & [B65000].End(xlUp))    ' Définit plage B
    f.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp             ' Supprime cellules vides
    f.RemoveDuplicates Columns:=1, Header:=xlNo                     ' Supprime doublons
End Sub
 

Pièces jointes

  • essai1.xlsm
    46.1 KB · Affichages: 3

jpg21

XLDnaute Nouveau
Bonjour Sylvanu

Tout d abord merci pour ton aide.

j'ai regardé l essai joint mais j ai toujours le même problème .
Je me suis mal exprimé . Mon problème c est que lorsque'on copie les valeurs dans la colonne B, elles sont écrasées.
Je voudrais qu elles soient conservées mais qu il n'y ait plus de doublon .

Encore merci

JPG21
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
Oups, "ajouter " m'avait échappé. :rolleyes:
Un nouvel essai en PJ :
VB:
Sub SansDoublonsTrié2()
    Application.ScreenUpdating = False                              ' Fige écran
    Set f = Sheets("tableau").[A65000].End(xlUp)                    ' Définit plage A
    DLA = 1 + [A65000].End(xlUp).Row                                ' Première ligne vide de A
    DLB = 1 + [B65000].End(xlUp).Row                                ' Première ligne vide de B
    Range("B" & DLB & ":B" & DLB + DLA - 5).Value = Range("A5:A" & DLA).Value ' Tranfert valeurs
    Set f = Sheets("tableau").Range("B5:B" & [B65000].End(xlUp))    ' Définit plage B
    f.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp             ' Supprime cellules vides
    f.RemoveDuplicates Columns:=1, Header:=xlNo                     ' Supprime doublons
    With Range("B5:B1000")                                          ' Mise en forme police, centrage
        .HorizontalAlignment = xlCenter
        .Font.Name = "Calibri"
        .Font.Size = 8
    End With
End Sub
 

Pièces jointes

  • essai1 (V2).xlsm
    48.8 KB · Affichages: 6

Discussions similaires

Statistiques des forums

Discussions
299 728
Messages
1 978 766
Membres
206 374
dernier inscrit
Agence Attic