Suppression d'une ligne entière selon critères

Fibule86

XLDnaute Nouveau
Bonjour à tous ,

Je souhaite pouvoir supprimer les doublons (ne garder qu'une ligne) mais en copiant les information d'une ligne sur l'autre.
Par exemple : Que le cellule F3 se copie dans la cellule F2 uniquement si A2 et B2 soit strictement identique s à A3 et B3
J'espère me faire comprendre...
J'ai trouvé ce post qui m'a l'air bien mais je ne comprends pas trop comment faire (je suis auto didacte et le vba est encore une grande enigme pour moi)...........

Merci pour votre aide.

Fibule
 

Pièces jointes

  • doublon_excel_download_fibule.xlsm
    18.4 KB · Affichages: 38
  • doublon_excel_download_fibule.xlsm
    18.4 KB · Affichages: 31

Paf

XLDnaute Barbatruc
Re : Suppression d'une ligne entière selon critères

bonjour Fibule86, gosselien,

un essai macro

Code:
Private Sub CommandButton1_Click()
 Dim i As Long
 With Worksheets("Feuil1")
 For i = .Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1
    If .Cells(i, 1) = .Cells(i - 1, 1) And .Cells(i, 2) = .Cells(i - 1, 2) Then
        .Cells(i - 1, 6) = .Cells(i - 1, 6).Value
        .Cells(i - 1, 7) = .Cells(i - 1, 7).Value
        If .Cells(i, 6) <> "" Then .Cells(i - 1, 6) = .Cells(i, 6)
        If .Cells(i, 7) <> "" Then .Cells(i - 1, 7) = .Cells(i, 7)
        .Rows(i).Delete
    End If
 Next
 End With
End Sub

les formules en colonnes F et G des lignes modifiées sont remplacées par leur valeur.

A+
 

gosselien

XLDnaute Barbatruc
Re : Suppression d'une ligne entière selon critères

re,

le code de Paf au post#3 à qui tu n'as pas répondu fait ce qui est demandé :)

P.

ps: sur ton fichier exemple; j'ai un résultat un peu différent :)

Code:
Sub RegroupeLigneS()
  Set d1 = CreateObject("Scripting.Dictionary")
  Set f1 = Sheets("feuil1")
  Set f2 = Range("J1")
  ncol = f1.[a1].CurrentRegion.Columns.Count
  nlig = f1.[a1].CurrentRegion.Rows.Count
  d1.CompareMode = vbTextCompare
  For ligne = 1 To nlig
    crit = f1.Cells(ligne, 1) & f1.Cells(ligne, 2) ' nom+prenom
    d1(crit) = ""
    ligT = Application.Match(crit, d1.keys, 0)
    For col = 1 To ncol
      If f1.Cells(ligne, col) <> "" Then f2.Cells(ligT, col) = f1.Cells(ligne, col).Text
    Next col
    If f1.Cells(ligne, ncol) <> "" Then f1.Cells(ligne, ncol).Copy f2.Cells(ligT, ncol)
  Next ligne
End Sub
 
Dernière édition:

Fibule86

XLDnaute Nouveau
Re : Suppression d'une ligne entière selon critères

Paf et Gosselien,

Excusez moi pour la réponse tardive mais j'étais loin de mon ordi ( et oui ça arrive...)

Merci pour ces macros que je vais étudier de près étant donné que que je suis plus que novice en vba :rolleyes:

Merci encore
 

Discussions similaires

Statistiques des forums

Discussions
312 489
Messages
2 088 853
Membres
103 975
dernier inscrit
denry