EXCEL- VBA Suppression de ligne en fonction des doublons

Question

Bonjour, je suis nouveau sur le forum et j'ai besoin d'aide. J'ai un souci dans mon code VBA. En effet, j'ai un code avec un grand nombre de fonctionnalités qui fonctionne parfaitement (traitement de données, séparation de données, création d'onglet...), mais une étape bloque dans deux de mes onglets. Je souhaite supprimer les lignes (entières) s'il y a des doublons dans la colonne B. Les deux onglets sont "BDD DA" et "BDD CDE". Actuellement, le code supprime les doublons, mais il crée un décalage dans mes bases de données. J'ai mis en gras la partie du code qui ne fonctionne pas correctement.

Pouvez-vous m'aider ? Un grand merci d'avance.

Le code est le suivant :

Sub CopierCollerDonneesAvecSuppressionEtAutresTaches()
Dim CheminFichier As String
Dim FeuilleDestination As Worksheet
Dim FeuilleSource As Worksheet ' Ajout de la feuille source
Dim DerniereLigne As Long
Dim i As Long

' Ouvrir l'explorateur de fichiers pour sélectionner le fichier source
CheminFichier = Application.GetOpenFilename("Fichiers Excel (*.xlsx; *.xls), *.xlsx; *.xls")

' Vérifier si un fichier a été sélectionné
If CheminFichier = "Faux" Then
MsgBox "Aucun fichier sélectionné. La macro est annulée."
Exit Sub
End If

' Désactiver les mises à jour de l'application Excel pour accélérer le traitement
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.CutCopyMode = False

' Créer deux nouveaux onglets
Set FeuilleDestination = ThisWorkbook.Sheets.Add
FeuilleDestination.Name = "Donnees1"
ThisWorkbook.Sheets.Add
Set FeuilleDestination = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
FeuilleDestination.Name = "DonneesATraiter" ' Renommer le deuxième onglet

' Copier les données du fichier sélectionné
Workbooks.Open CheminFichier
ActiveWorkbook.Sheets(1).UsedRange.Copy
ThisWorkbook.Sheets("Donnees1").Range("A1").PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Sheets("DonneesATraiter").Range("A1").PasteSpecial Paste:=xlPasteValues

' Fermer le fichier source sans enregistrer
ActiveWorkbook.Close SaveChanges:=False

' Nettoyer le Presse-Papiers
Application.CutCopyMode = False

' Convertir les données de la colonne A en valeurs statiques (données uniquement)
ThisWorkbook.Sheets("DonneesATraiter").Columns("A:A").Value = ThisWorkbook.Sheets("DonneesATraiter").Columns("A:A").Value

' Trouver la dernière ligne dans la colonne A de DonneesATraiter
DerniereLigne = ThisWorkbook.Sheets("DonneesATraiter").Cells(ThisWorkbook.Sheets("DonneesATraiter").Rows.Count, "A").End(xlUp).Row

' Remplacer les cases vides dans la colonne D par "SANS DA"
For i = 1 To DerniereLigne
If ThisWorkbook.Sheets("DonneesATraiter").Cells(i, "A").Value <> "" And ThisWorkbook.Sheets("DonneesATraiter").Cells(i, "D").Value = "" Then
ThisWorkbook.Sheets("DonneesATraiter").Cells(i, "D").Value = "SANS DA"
End If
Next i

' Ajouter la nouvelle colonne en A avec la formule
ThisWorkbook.Sheets("DonneesATraiter").Columns("A:A").Insert Shift:=xlToRight
ThisWorkbook.Sheets("DonneesATraiter").Range("A1").Value = "IMPACT DEXI"

' Trouver la dernière ligne dans la colonne B de DonneesATraiter
DerniereLigne = ThisWorkbook.Sheets("DonneesATraiter").Cells(ThisWorkbook.Sheets("DonneesATraiter").Rows.Count, "B").End(xlUp).Row

' Copier les données de la colonne A en tant que valeurs uniquement
ThisWorkbook.Sheets("DonneesATraiter").Columns("A:A").Value = ThisWorkbook.Sheets("DonneesATraiter").Columns("A:A").Value

' Supprimer les lignes où la colonne A contient "_HORS DEXI" en une seule opération
ThisWorkbook.Sheets("DonneesATraiter").AutoFilterMode = False ' Désactiver tout filtre existant
ThisWorkbook.Sheets("DonneesATraiter").Range("A1:A" & DerniereLigne).AutoFilter Field:=1, Criteria1:="_HORS DEXI"
ThisWorkbook.Sheets("DonneesATraiter").AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ThisWorkbook.Sheets("DonneesATraiter").AutoFilterMode = False ' Désactiver le filtre

' Définir la feuille source pour la copie ultérieure
Set FeuilleSource = ThisWorkbook.Sheets("DonneesATraiter")

' Créer l'onglet "BDD DA" et copier les colonnes A à N et la colonne Y
Dim FeuilleBDDDA As Worksheet
Set FeuilleBDDDA = ThisWorkbook.Sheets.Add
FeuilleBDDDA.Name = "BDD DA"
FeuilleSource.Range("A:N,Y:Y").Copy Destination:=FeuilleBDDDA.Range("A1")

' Supprimer les lignes où la colonne E contient "SANS DA" en une seule opération dans l'onglet BDD DA
Dim DerniereLigneBDDDA As Long
DerniereLigneBDDDA = FeuilleBDDDA.Cells(FeuilleBDDDA.Rows.Count, "A").End(xlUp).Row
FeuilleBDDDA.AutoFilterMode = False ' Désactiver tout filtre existant
FeuilleBDDDA.Range("E1:E" & DerniereLigneBDDDA).AutoFilter Field:=1, Criteria1:="SANS DA"
FeuilleBDDDA.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
FeuilleBDDDA.AutoFilterMode = False ' Désactiver le filtre

' Ajouter la nouvelle colonne B en B1 avec l'en-tête "CONCAT DA/POSTE" dans l'onglet BDD DA
FeuilleBDDDA.Range("B1").Value = "CONCAT DA/POSTE"

' Appliquer la formule pour concaténer les colonnes E et F à partir de B2 dans l'onglet BDD DA
FeuilleBDDDA.Range("B2:B" & DerniereLigneBDDDA).FormulaR1C1 = "=RC[3] & "" "" & RC[4]"

FeuilleBDDDA.Columns("B:B").Value = FeuilleBDDDA.Columns("B:B").Value

' Supprimer les doublons dans la colonne B de l'onglet BDD DA
FeuilleBDDDA.Range("B1:B" & DerniereLigneBDDDA).RemoveDuplicates Columns:=1, Header:=xlYes

' Supprimer les lignes où la colonne B est vide dans l'onglet BDD DA, mais seulement si la colonne A n'est pas vide
DerniereLigneBDDDA = FeuilleBDDDA.Cells(FeuilleBDDDA.Rows.Count, "A").End(xlUp).Row

' Activer le filtre pour la colonne A non vide et la colonne B vide
FeuilleBDDDA.Range("A1:B" & DerniereLigneBDDDA).AutoFilter Field:=1, Criteria1:="<>"
FeuilleBDDDA.Range("B1:B" & DerniereLigneBDDDA).AutoFilter Field:=2, Criteria1:=""

' Supprimer les lignes visibles (lignes où la colonne A n'est pas vide et la colonne B est vide)
FeuilleBDDDA.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
FeuilleBDDDA.AutoFilterMode = False

' Créer l'onglet "BDD CDE"
Dim FeuilleBDDCDE As Worksheet
Set FeuilleBDDCDE = ThisWorkbook.Sheets.Add
FeuilleBDDCDE.Name = "BDD CDE"

' Copier les colonnes A à F et P à AI depuis l'onglet DonneesATraiter vers l'onglet BDD CDE
FeuilleSource.Range("A:F,P:AI").Copy Destination:=FeuilleBDDCDE.Range("A1")

' Ajouter une nouvelle colonne à côté de la colonne B existante dans l'onglet BDD CDE
FeuilleBDDCDE.Columns("B:B").Insert Shift:=xlToRight

' Ajouter l'en-tête "CONCAT CDE/POSTE" dans la nouvelle colonne C
FeuilleBDDCDE.Range("B1").Value = "CONCAT CDE/POSTE"

' Appliquer la formule pour concaténer les colonnes H et I à partir de C2 dans l'onglet BDD CDE
Dim DerniereLigneBDDCDE As Long
DerniereLigneBDDCDE = FeuilleBDDCDE.Cells(FeuilleBDDCDE.Rows.Count, "A").End(xlUp).Row
FeuilleBDDCDE.Range("B2:B" & DerniereLigneBDDCDE).FormulaR1C1 = "=RC[6] & "" "" & RC[7]"

FeuilleBDDCDE.Columns("B:B").Value = FeuilleBDDCDE.Columns("B:B").Value

' Supprimer les doublons dans la colonne B de l'onglet BDD CDE
DerniereLigneBDDCDE = FeuilleBDDCDE.Cells(FeuilleBDDCDE.Rows.Count, "B").End(xlUp).Row
FeuilleBDDCDE.Range("B1:B" & DerniereLigneBDDCDE).RemoveDuplicates Columns:=1, Header:=xlYes

' Activer le filtre pour la colonne A non vide et la colonne B vide
FeuilleBDDCDE.Range("A1:B" & DerniereLigneBDDCDE).AutoFilter Field:=1, Criteria1:="<>"
FeuilleBDDCDE.Range("B1:B" & DerniereLigneBDDCDE).AutoFilter Field:=2, Criteria1:=""

' Supprimer les lignes visibles (lignes où la colonne A n'est pas vide et la colonne B est vide)
FeuilleBDDCDE.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
FeuilleBDDCDE.AutoFilterMode = False

' Créer l'onglet "BDD FACT"
Dim FeuilleBDDFACT As Worksheet
Set FeuilleBDDFACT = ThisWorkbook.Sheets.Add
FeuilleBDDFACT.Name = "BDD FACT"

' Copier les colonnes A à F, P, Q, Y, AK à AY depuis l'onglet DonneesATraiter vers l'onglet BDD FACT
FeuilleSource.Range("A:F,P:Q,Y:Y,AK:AY").Copy Destination:=FeuilleBDDFACT.Range("A1")

' Supprimer les lignes où la colonne J est vide dans l'onglet BDD FACT
DerniereLigne = FeuilleBDDFACT.Cells(FeuilleBDDFACT.Rows.Count, "J").End(xlUp).Row
FeuilleBDDFACT.AutoFilterMode = False ' Désactiver tout filtre existant
FeuilleBDDFACT.Range("J1:J" & DerniereLigne).AutoFilter Field:=1, Criteria1:="="
FeuilleBDDFACT.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
FeuilleBDDFACT.AutoFilterMode = False

' Réactiver les mises à jour de l'application Excel
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Edit modo : code à mettre entre balises avec le bouton </> merci d'y faire attention

Arturo83 · Accepted Answer

Je vous remets la macro qui ne traite que la suppression des doublons, légèrement améliorée pour un fonctionnement plus fiable.

Sub Supprimer_les_doublons()
    Dim f_bdd As Worksheet
    Dim i As Long
    Dim c As Long
    Dim DerLig As Long, DerCol As Long

    ' Réactiver les mises à jour de l'application Excel
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    For c = 1 To Sheets.Count 'on passe sur toutes les feuilles
        If Sheets(c).Name = "BDD DA" Or Sheets(c).Name = "BDD CDE" Then 'si ce sont celles que l'on doit traiter, alors:
            Set f_bdd = Sheets(Sheets(c).Name) 'on attribue la variable "f_dd" à la feuille à traiter
            f_bdd.Activate
            DerLig = f_bdd.Range("A" & Rows.Count).End(xlUp).Row 'on cherche sa dernière ligne par rapport à la colonne B
            DerCol = f_bdd.Range("A1").End(xlToRight).Column + 1
            If f_bdd.AutoFilterMode = False Then
                Range(f_bdd.Cells(1, "A"), f_bdd.Cells(1, DerCol + 1)).AutoFilter 'on ajoute le filtre sur la ligne 1
            Else
                f_bdd.AutoFilterMode = False 'on supprime le filtre existant au cas où il balayerait pas toutes les colonnes
                Range(f_bdd.Cells(1, "A"), f_bdd.Cells(1, DerCol + 1)).AutoFilter ' on met le fitre sur toutes les colonnes
            End If
            Range(f_bdd.Cells(2, DerCol), f_bdd.Cells(DerLig, DerCol)).FormulaR1C1 = "=COUNTIF(R1C2:RC2,RC2)"  'application d'une formule pour comptage
            Range(f_bdd.Cells(2, DerCol), f_bdd.Cells(DerLig, DerCol)).Value = Range(f_bdd.Cells(2, DerCol), f_bdd.Cells(DerLig, DerCol)).Value    'remplacement par les valeure
            If f_bdd.AutoFilterMode = False Then Range(f_bdd.Cells(1, DerCol), f_bdd.Cells(1, DerCol)).AutoFilter  'appliquer un filtre
            ActiveSheet.Range(f_bdd.Cells(1, DerCol), f_bdd.Cells(1, DerCol)).AutoFilter Field:=DerCol, Criteria1:=">1"  'filtrer sur tout ce qui est supérieur à 1
            ActiveSheet.Rows("2:" & DerLig).SpecialCells(xlCellTypeVisible).Delete 'supprimer la zone filtrée
            ActiveSheet.ShowAllData
        End If
    Next c ' feuille suivante
    Set f_bdd = Nothing
End Sub

j'ai testée plusieurs fois avec un fichier contenant les 3 feuilles et le résultat est correct.

Cdlt

Invité · Answer

Je vous invite à lire la charte du forum &#91;A LIRE AVANT DE POSTER&#93; qui vous aidera dans vos demandes et réponses sur ce forum et notamment : Pour plus de lisibilité, utilisez la fonctionnalité &lt;/&gt; pour insérer vos codes VBA (et si possible aussi pour vos formules Excel). Si une ligne spécifique pose problème, indiquez le en commentaire dans le code Merci de votre participation et de votre compréhension...

Arturo83 · Answer

En revenant à des méthodes basiques, simples et efficaces: Dim i As Long, j As Long Dim DerLig As Long Dim f_bdd As Worksheet For i = 1 To Sheets.Count 'on passe sur toutes les feuilles If Sheets(i).Name = "BDD DA" Or Sheets(i).Name = "BDD CDE" Then 'si ce sont celles que l'on doit traiter, alors: Set f_bdd = Sheets(Sheets(i).Name) 'on attribue la variable "f_dd" à la feuille à traiter DerLig = f_bdd.Range("A" & Rows.Count).End(xlUp).Row 'on cherche sa dernière ligne par rapport à la colonne B For j = DerLig To 2 Step -1 'on part de la dernière ligne en remontant If Application.WorksheetFunction.CountIf(f_bdd.Range("B1:B" & DerLig), f_bdd.Cells(j, "B")) &gt; 1 Then 'on compte le nombre de fois où la valeur existe f_bdd.Rows(j).Delete ' si le nombre de fois est supérieur à 1, alors on supprime la ligne End If Next j 'ligne suivante End If Next i ' feuille suivante Cdlt...

Optimix · Answer

Vous écrivez : Bizarre. Exemple : vous insérez une colonne A à la ligne 54... ...un peu plus loin (ligne 64), vous traitez cette colonne vide comme s'il y avait des données dedans : Question : êtes-vous certain de nous avoir donné le bon code et pourquoi n'avoir pas proposé le fichier XLSM lui-même vidé des éventuels onglets inutiles ? Enfin, le point le plus important : nous aurions besoin du fichier à importer, car il contient des choses qu'on ne peut pas deviner, dont des formules...

Arturo83 · Answer

Autre proposition, dans une colonne libre, on applique une formule qui compte le nombre de valeurs identiques, puis on applique un filtre sur cette colonne, seulement sur les valeurs supérieures à 1(c'est quelles sont en doublons), puis on supprime cette zone filtrée. Essayez ceci( pas pu tester). Sub CopierCollerDonneesAvecSuppressionEtAutresTaches() Dim CheminFichier As String Dim FeuilleDestination As Worksheet Dim FeuilleSource As Worksheet ' Ajout de la feuille source Dim DerniereLigne As Long Dim i As Long Dim c As Long, j As Long Dim DerLig As Long, DerCol As Long Dim f_bdd As Worksheet ' Ouvrir l'explorateur de fichiers pour sélectionner le fichier source CheminFichier = Application.GetOpenFilename("Fichiers Excel (*.xlsx; *.xls), *.xlsx; *.xls") ' Vérifier si un fichier a été sélectionné If CheminFichier = "Faux" Then MsgBox "Aucun fichier sélectionné. La macro est annulée." Exit Sub End If ' Désactiver les mises à jour de l'application Excel pour accélérer le traitement Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' Créer deux nouveaux onglets Set FeuilleDestination = ThisWorkbook.Sheets.Add FeuilleDestination.Name = "Donnees1" ThisWorkbook.Sheets.Add Set FeuilleDestination = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) FeuilleDestination.Name = "DonneesATraiter" ' Renommer le deuxième onglet ' Copier les données du fichier sélectionné Workbooks.Open CheminFichier ActiveWorkbook.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets("Donnees1").Range("A1").PasteSpecial Paste:=xlPasteValues ThisWorkbook.Sheets("DonneesATraiter").Range("A1").PasteSpecial Paste:=xlPasteValues ' Fermer le fichier source sans enregistrer ActiveWorkbook.Close SaveChanges:=False ' Nettoyer le Presse-Papiers Application.CutCopyMode = False ' Convertir les données de la colonne A en valeurs statiques (données uniquement) ThisWorkbook.Sheets("DonneesATraiter").Columns("A:A").Value = ThisWorkbook.Sheets("DonneesATraiter").Columns("A:A").Value ' Trouver la dernière ligne dans la colonne A de DonneesATraiter DerniereLigne = ThisWorkbook.Sheets("DonneesATraiter").Cells(ThisWorkbook.Sheets("DonneesATraiter").Rows.Count, "A").End(xlUp).Row ' Remplacer les cases vides dans la colonne D par "SANS DA" For i = 1 To DerniereLigne If ThisWorkbook.Sheets("DonneesATraiter").Cells(i, "A").Value &lt;&gt; "" And ThisWorkbook.Sheets("DonneesATraiter").Cells(i, "D").Value = "" Then ThisWorkbook.Sheets("DonneesATraiter").Cells(i, "D").Value = "SANS DA" End If Next i ' Ajouter la nouvelle colonne en A avec la formule ThisWorkbook.Sheets("DonneesATraiter").Columns("A:A").Insert Shift:=xlToRight ThisWorkbook.Sheets("DonneesATraiter").Range("A1").Value = "IMPACT DEXI" ' Trouver la dernière ligne dans la colonne B de DonneesATraiter DerniereLigne = ThisWorkbook.Sheets("DonneesATraiter").Cells(ThisWorkbook.Sheets("DonneesATraiter").Rows.Count, "B").End(xlUp).Row ' Copier la formule dans la colonne A jusqu'à la dernière ligne de la colonne B ThisWorkbook.Sheets("DonneesATraiter").Range("A2:A" & DerniereLigne).FormulaR1C1 = _ ""=IF(ISNA(VLOOKUP(RC&#91;1&#93;,'cooperactions/sites/PERFORMANCEDEXI/Pilotage de la Performance DEXI/Pilotage de la Performance DEXI/Référentiels DEXI/&#91;REFERENTIEL DEXI- CDC.xlsx&#93;REFERENTIEL'!C13,1,FALSE)),""_HORS DEXI"",VLOOKUP(RC&#91;1&#93;,'cooperactions/sites/PERFORMANCEDEXI/Pilotage de la Performance DEXI/Pilotage de la Performance DEXI/Référentiels DEXI/&#91;REFERENTIEL DEXI- CDC.xlsx&#93;REFERENTIEL'!C13,1,FALSE))" 'Je n'ai pas le droit de poster de lien sur le forum et la formule contient un lien, ne pas prendre en compte cette ligne. Elle fonctionne dans mon code ' Copier les données de la colonne A en tant que valeurs uniquement ThisWorkbook.Sheets("DonneesATraiter").Columns("A:A").Value = ThisWorkbook.Sheets("DonneesATraiter").Columns("A:A").Value ' Supprimer les lignes où la colonne A contient "_HORS DEXI" en une seule opération ThisWorkbook.Sheets("DonneesATraiter").AutoFilterMode = False ' Désactiver tout filtre existant ThisWorkbook.Sheets("DonneesATraiter").Range("A1:A" & DerniereLigne).AutoFilter Field:=1, Criteria1:="_HORS DEXI" ThisWorkbook.Sheets("DonneesATraiter").AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete ThisWorkbook.Sheets("DonneesATraiter").AutoFilterMode = False ' Désactiver le filtre ' Définir la feuille source pour la copie ultérieure Set FeuilleSource = ThisWorkbook.Sheets("DonneesATraiter") ' Créer l'onglet "BDD DA" et copier les colonnes A à N et la colonne Y Dim FeuilleBDDDA As Worksheet Set FeuilleBDDDA = ThisWorkbook.Sheets.Add FeuilleBDDDA.Name = "BDD DA" FeuilleSource.Range("A:N,Y:Y").Copy Destination:=FeuilleBDDDA.Range("A1") ' Supprimer les lignes où la colonne E contient "SANS DA" en une seule opération dans l'onglet BDD DA Dim DerniereLigneBDDDA As Long DerniereLigneBDDDA = FeuilleBDDDA.Cells(FeuilleBDDDA.Rows.Count, "A").End(xlUp).Row FeuilleBDDDA.AutoFilterMode = False ' Désactiver tout filtre existant FeuilleBDDDA.Range("E1:E" & DerniereLigneBDDDA).AutoFilter Field:=1, Criteria1:="SANS DA" FeuilleBDDDA.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete FeuilleBDDDA.AutoFilterMode = False ' Désactiver le filtre ' Ajouter la nouvelle colonne B en B1 avec l'en-tête "CONCAT DA/POSTE" dans l'onglet BDD DA FeuilleBDDDA.Range("B1").Value = "CONCAT DA/POSTE" Dim LastRow As Long Dim b As Long ' Trouver la dernière ligne avec des données dans la colonne A LastRow = FeuilleBDDDA.Cells(FeuilleBDDDA.Rows.Count, "A").End(xlUp).Row ' Parcourir les lignes en commençant par la première For b = 2 To LastRow ' Commencez depuis la ligne 2 jusqu'à la dernière ligne avec des données dans la colonne A If Not IsEmpty(FeuilleBDDDA.Cells(b, "A")) Then ' Vérifiez si la cellule de la colonne A n'est pas vide ' Si la cellule A n'est pas vide, alors appliquez la formule de concaténation pour les colonnes E et F FeuilleBDDDA.Cells(b, "B").FormulaR1C1 = "=RC&#91;3&#93; & "" "" & RC&#91;4&#93;" End If Next b ThisWorkbook.Sheets("BDD DA").Columns("B:B").Value = ThisWorkbook.Sheets("BDD DA").Columns("B:B").Value ' Créer l'onglet "BDD CDE" Dim FeuilleBDDCDE As Worksheet Set FeuilleBDDCDE = ThisWorkbook.Sheets.Add FeuilleBDDCDE.Name = "BDD CDE" ' Copier les colonnes A à F et P à AI depuis l'onglet DonneesATraiter vers l'onglet BDD CDE FeuilleSource.Range("A:F,P:AI").Copy Destination:=FeuilleBDDCDE.Range("A1") ' Ajouter une nouvelle colonne à côté de la colonne B existante dans l'onglet BDD CDE FeuilleBDDCDE.Columns("B:B").Insert Shift:=xlToRight ' Ajouter l'en-tête "CONCAT CDE/POSTE" dans la nouvelle colonne C FeuilleBDDCDE.Range("B1").Value = "CONCAT CDE/POSTE" ' Appliquer la formule pour concaténer les colonnes H et I à partir de C2 dans l'onglet BDD CDE Dim DerniereLigneBDDCDE As Long DerniereLigneBDDCDE = FeuilleBDDCDE.Cells(FeuilleBDDCDE.Rows.Count, "A").End(xlUp).Row FeuilleBDDCDE.Range("B2:B" & DerniereLigneBDDCDE).FormulaR1C1 = "=RC&#91;6&#93; & "" "" & RC&#91;7&#93;" ' Copier les données de la colonne A en tant que valeurs uniquement ThisWorkbook.Sheets("BDD CDE").Columns("B:B").Value = ThisWorkbook.Sheets("BDD CDE").Columns("B:B").Value ' Créer l'onglet "BDD FACT" Dim FeuilleBDDFACT As Worksheet Set FeuilleBDDFACT = ThisWorkbook.Sheets.Add FeuilleBDDFACT.Name = "BDD FACT" ' Copier les colonnes A à F, P, Q, Y, AK à AY depuis l'onglet DonneesATraiter vers l'onglet BDD FACT FeuilleSource.Range("A:F,P:Q,Y:Y,AK:AY").Copy Destination:=FeuilleBDDFACT.Range("A1") ' Réactiver les mises à jour de l'application Excel Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic For c = 1 To Sheets.Count 'on passe sur toutes les feuilles If Sheets(c).Name = "BDD DA" Or Sheets(c).Name = "BDD CDE" Then 'si ce sont celles que l'on doit traiter, alors: Set f_bdd = Sheets(Sheets(c).Name) 'on attribue la variable "f_dd" à la feuille à traiter DerLig = f_bdd.Range("A" & Rows.Count).End(xlUp).Row 'on cherche sa dernière ligne par rapport à la colonne B DerCol = f_bdd.Range("A1").End(xlToRight).Column Range(f_bdd.Cells(2, DerCol + 1), f_bdd.Cells(DerLig, DerCol + 1)).FormulaR1C1 = "=COUNTIF(R1C2:RC2,RC2)" 'application d'une formule pour comptage Range(f_bdd.Cells(2, DerCol + 1), f_bdd.Cells(DerLig, DerCol + 1)).Value = Range(f_bdd.Cells(2, DerCol + 1), f_bdd.Cells(DerLig, DerCol + 1)).Value 'remplacement par les valeure f_bdd.Activate If f_bdd.AutoFilterMode = False Then Range(f_bdd.Cells(1, DerCol + 1), f_bdd.Cells(1, DerCol + 1)).AutoFilter 'appliquer un filtre ActiveSheet.Range(f_bdd.Cells(1, DerCol + 1), f_bdd.Cells(1, DerCol + 1)).AutoFilter Field:=DerCol + 1, Criteria1:="&gt;1" 'filtrer sur tout ce qui est supérieur à 1 ActiveSheet.Rows("2:" & DerLig).SpecialCells(xlCellTypeVisible).Delete 'supprimer la zone filtrée End If Next c ' feuille suivante 'Une fonction qui permet la suppression des lignes quand dans la colonne J il y a seulement un espace ou si elle est vide FeuilleBDDFACT.UsedRange.AutoFilter Field:=10, Criteria1:="=" FeuilleBDDFACT.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete FeuilleBDDFACT.AutoFilterMode = False End Sub Cdlt...

Arturo83 · Answer

J'ai effectué le test, mais c'est bien ce que je pensais : étant donné que l'on supprime toutes les lignes supérieures à 1, on supprime aussi la première ligne des doublons, c'est-à-dire la ligne que l'on souhaite conserver. Ah bon,, avez-vous penser à supprimer le filtre de la colonne supplémentaire après l'exécution de la macro? Tout ce qui est à reste dans le tableau. Exemple ci-dessous avec un tableau de valeurs. Tous les doublons se marquent du chiffre 2 dans la dernière colonne, après exécution de la macro et après avoir supprimer le filtre, il ne reste que les lignes à 1 Cdlt...

Invité · Answer

@AJ1234567 afin que l'on puisse parler la même langue sur ce forum, je vous demanderais de joindre un fichier ( comme il est indiqué dans la charte ) à cet échange Dans le cas contraire je me verrais dans l'obligation de clôturer cette discussion Merci de votre compréhension Nota : ce n'est pas normal, ce n'est pas au contributeur de se "taper" un fichier à faire...

Arturo83 · Answer

Votre document ne contient qu'une feuille, j'ai adapté la macro pour traiter que cette feuille, mais le principe reste la même. La macro ne traite que la partie suppression des doublons. Cdlt...

Ordonc · Answer

Bonjour … Merci Arturo pour tes fichiers joints. Excuse-moi AJI123... de ne pas te présenter une solution… mais la coupe d’abus envers des Demandeurs, nouveaux ou pas, commence à déborder. Oups, une fois de plus, je vais ramener ma fraise ! Je donne mon avis concernant BRUNO, Dans son intervention : - Dernière de ses phrases : Nul ne nous oblige faire ce travail pour donner une réponse. On offre quand le sujet nous plait sinon on laisse la place, sans rechigner, à d’autres ! - Avant dernière phrase : comment comprendre quelqu’un qui agit de cette façon car avec la … - première phrase : Clôturer une discussion est un abus qui prive stupidement des lecteurs, intéressés par le sujet, de proposer une réponse ou de profiter de réponses pouvant être utilisées dans leurs études ( qui ne pourront être données à cause de ce blocage ). Ce n’est pas à un adhérent ( comme il se présente ) à un Forum de partages grâcieux ( conviviaux et offerts ) d’agir brutalement ainsi. Pour ceux qui ne comprendront pas mon message, je sais qu’un Modérateur a un travail délicat, cependant, le tout premier n’est pas d’interpréter à sa façon la Charte mais plutôt de citer le début de la règle non respectée. Dans cas présent, il est nullement écrit que l’on soit obligé de joindre une fichier ; il y est écrit, très convivialement, « Joignez (si possible) un fichier pour augmenter vos chances d'obtenir … » ! J’ai trop souvent été privé, comme beaucoup je le crois, d’offrir des réponses donc de satisfaire des Demandeurs, et même, certains Répondeurs découvrant des méthodes auxquelles ils n’y avaient pas été formés...

Ordonc · Answer

Merci pour ce retour. J’espère pouvoir t’aiguiller dans tes futures demandes, en plus cela me permettra de nouveaux échanges avec Arturo qui est bien récompensé pour ses interventions...