Un GRAND merci à toi pour le temps passer à résoudre mes demandes ...
Une petite dernière,
Comment mettre les 2 macros ensemble ?
Celle du classement de lignes et celle qui supprime les doublons,
@+
Romeo59181
Ps : Petite confirmation au passage la suppression de doublon contrôle bien les colonnes b & c ?
"FFO" a écrit dans le message de groupe de discussion :
Rebonjour à toi
Pour la suppression des lignes en double ce code modifié est plus rapide que celui que je t'ai proposé :
Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate Do While ActiveCell.Offset(-i, 0).Row > 1 For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i, 0).Row - 1, j) Then Divergence = 1 Exit For End If Next If Divergence <> 1 Then ActiveCell.Offset(-i, 0).EntireRow.Clear End If Divergence = "" i = i + 1 Loop Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A1").Activate
Essayes le et dis moi !!!!
Bonjour,
Un GRAND merci à toi pour le temps passer à résoudre mes demandes ...
Une petite dernière,
Comment mettre les 2 macros ensemble ?
Celle du classement de lignes et celle qui supprime les doublons,
@+
Romeo59181
Ps : Petite confirmation au passage la suppression de doublon contrôle bien
les colonnes b & c ?
"FFO" <FFO@discussions.microsoft.com> a écrit dans le message de groupe de
discussion : 579577B8-2C9D-4A40-9673-4B56F9C1E569@microsoft.com...
Rebonjour à toi
Pour la suppression des lignes en double ce code modifié est plus rapide
que
celui que je t'ai proposé :
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate
Do While ActiveCell.Offset(-i, 0).Row > 1
For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column
If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i,
0).Row - 1, j) Then
Divergence = 1
Exit For
End If
Next
If Divergence <> 1 Then
ActiveCell.Offset(-i, 0).EntireRow.Clear
End If
Divergence = ""
i = i + 1
Loop
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Activate
Un GRAND merci à toi pour le temps passer à résoudre mes demandes ...
Une petite dernière,
Comment mettre les 2 macros ensemble ?
Celle du classement de lignes et celle qui supprime les doublons,
@+
Romeo59181
Ps : Petite confirmation au passage la suppression de doublon contrôle bien les colonnes b & c ?
"FFO" a écrit dans le message de groupe de discussion :
Rebonjour à toi
Pour la suppression des lignes en double ce code modifié est plus rapide que celui que je t'ai proposé :
Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate Do While ActiveCell.Offset(-i, 0).Row > 1 For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i, 0).Row - 1, j) Then Divergence = 1 Exit For End If Next If Divergence <> 1 Then ActiveCell.Offset(-i, 0).EntireRow.Clear End If Divergence = "" i = i + 1 Loop Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A1").Activate
Essayes le et dis moi !!!!
FFO
Rebonjour romero
Enfin content que tu sois satisfait
Pour faire fonctionner les 2 codes ensembles tu peux soit les mettre l'un aprés l'autre dans chaque Macro traitant les couleurs soit mettre le code traitant les doublons dans une nouvelle Macro ("Doublon") que tu appelleras à la fin de chaque code traitant les couleurs en mettant la ligne :
Run("Doublon")
Attention si le code traitant des couleurs fonctionne en l'état celui des doublons a besoin au préalable d'avoir l'onglet à traiter actif
Je ne sait pas si tous les Onglets comme pour les couleurs ont besoin d'être traité mais par onglet à traiter il faudra mettre :
Sheets("Onglet à traiter").Activate Par exemple pour l'Onglet "Général" il faut mettre : Sheets("Général").Activate Puis le code Doublon
Renouveler l'opération pour chaque Onglet concerné
L'ensemble de tout ces codes peuvent être mis l'un aprés l'autre dans une Macro
Mais si tous les Onglets sont à traiter je te préconise plustôt ce seul et unique code :
For k = 1 to Sheets.Count Sheets(k).Activate Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate Do While ActiveCell.Offset(-i, 0).Row > 1 For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i, 0).Row - 1, j) Then Divergence = 1 Exit For End If Next If Divergence <> 1 Then ActiveCell.Offset(-i, 0).EntireRow.Clear End If Divergence = "" i = i + 1 Loop Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A1").Activate Next
Si un onglet n'est pas à traiter tu peux mettre le code ci-dessus modifié ainsi :
For k = 1 to Sheets.Count If Sheets(k).Name <> "Nom de l'onglet à ne pas traiter" Sheets(k).Activate Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate Do While ActiveCell.Offset(-i, 0).Row > 1 For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i, 0).Row - 1, j) Then Divergence = 1 Exit For End If Next If Divergence <> 1 Then ActiveCell.Offset(-i, 0).EntireRow.Clear End If Divergence = "" i = i + 1 Loop Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A1").Activate End If Next
Le tout mis dans une seule Macro appelé "Doublon" que tu appellera à la fin de toutes tes Macros couleurs par la ligne :
Run("Doublon")
Espérant ne pas t'avoir noyé et répondu une fois de plus à ton attente
Dis moi !!!!
Rebonjour romero
Enfin content que tu sois satisfait
Pour faire fonctionner les 2 codes ensembles tu peux soit les mettre l'un
aprés l'autre dans chaque Macro traitant les couleurs soit mettre le code
traitant les doublons dans une nouvelle Macro ("Doublon") que tu appelleras à
la fin de chaque code traitant les couleurs en mettant la ligne :
Run("Doublon")
Attention si le code traitant des couleurs fonctionne en l'état celui des
doublons a besoin au préalable d'avoir l'onglet à traiter actif
Je ne sait pas si tous les Onglets comme pour les couleurs ont besoin d'être
traité mais par onglet à traiter il faudra mettre :
Sheets("Onglet à traiter").Activate
Par exemple pour l'Onglet "Général" il faut mettre :
Sheets("Général").Activate
Puis le code Doublon
Renouveler l'opération pour chaque Onglet concerné
L'ensemble de tout ces codes peuvent être mis l'un aprés l'autre dans une
Macro
Mais si tous les Onglets sont à traiter je te préconise plustôt ce seul et
unique code :
For k = 1 to Sheets.Count
Sheets(k).Activate
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate
Do While ActiveCell.Offset(-i, 0).Row > 1
For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column
If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i,
0).Row - 1, j) Then
Divergence = 1
Exit For
End If
Next
If Divergence <> 1 Then
ActiveCell.Offset(-i, 0).EntireRow.Clear
End If
Divergence = ""
i = i + 1
Loop
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Activate
Next
Si un onglet n'est pas à traiter tu peux mettre le code ci-dessus modifié
ainsi :
For k = 1 to Sheets.Count
If Sheets(k).Name <> "Nom de l'onglet à ne pas traiter"
Sheets(k).Activate
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate
Do While ActiveCell.Offset(-i, 0).Row > 1
For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column
If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i,
0).Row - 1, j) Then
Divergence = 1
Exit For
End If
Next
If Divergence <> 1 Then
ActiveCell.Offset(-i, 0).EntireRow.Clear
End If
Divergence = ""
i = i + 1
Loop
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Activate
End If
Next
Le tout mis dans une seule Macro appelé "Doublon" que tu appellera à la fin
de toutes tes Macros couleurs par la ligne :
Run("Doublon")
Espérant ne pas t'avoir noyé et répondu une fois de plus à ton attente
Pour faire fonctionner les 2 codes ensembles tu peux soit les mettre l'un aprés l'autre dans chaque Macro traitant les couleurs soit mettre le code traitant les doublons dans une nouvelle Macro ("Doublon") que tu appelleras à la fin de chaque code traitant les couleurs en mettant la ligne :
Run("Doublon")
Attention si le code traitant des couleurs fonctionne en l'état celui des doublons a besoin au préalable d'avoir l'onglet à traiter actif
Je ne sait pas si tous les Onglets comme pour les couleurs ont besoin d'être traité mais par onglet à traiter il faudra mettre :
Sheets("Onglet à traiter").Activate Par exemple pour l'Onglet "Général" il faut mettre : Sheets("Général").Activate Puis le code Doublon
Renouveler l'opération pour chaque Onglet concerné
L'ensemble de tout ces codes peuvent être mis l'un aprés l'autre dans une Macro
Mais si tous les Onglets sont à traiter je te préconise plustôt ce seul et unique code :
For k = 1 to Sheets.Count Sheets(k).Activate Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate Do While ActiveCell.Offset(-i, 0).Row > 1 For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i, 0).Row - 1, j) Then Divergence = 1 Exit For End If Next If Divergence <> 1 Then ActiveCell.Offset(-i, 0).EntireRow.Clear End If Divergence = "" i = i + 1 Loop Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A1").Activate Next
Si un onglet n'est pas à traiter tu peux mettre le code ci-dessus modifié ainsi :
For k = 1 to Sheets.Count If Sheets(k).Name <> "Nom de l'onglet à ne pas traiter" Sheets(k).Activate Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate Do While ActiveCell.Offset(-i, 0).Row > 1 For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i, 0).Row - 1, j) Then Divergence = 1 Exit For End If Next If Divergence <> 1 Then ActiveCell.Offset(-i, 0).EntireRow.Clear End If Divergence = "" i = i + 1 Loop Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A1").Activate End If Next
Le tout mis dans une seule Macro appelé "Doublon" que tu appellera à la fin de toutes tes Macros couleurs par la ligne :
Run("Doublon")
Espérant ne pas t'avoir noyé et répondu une fois de plus à ton attente
Dis moi !!!!
romeo59181
Bonjour,
Là j'avoue je suis noyé ...
lol
Les doublons sont à contrôler sur tous les onglets sur la colonne b & c ... ( Car la A est purement décorative )
@+
Romeo59181
"FFO" a écrit dans le message de groupe de discussion :
Rebonjour romero
Enfin content que tu sois satisfait
Pour faire fonctionner les 2 codes ensembles tu peux soit les mettre l'un aprés l'autre dans chaque Macro traitant les couleurs soit mettre le code traitant les doublons dans une nouvelle Macro ("Doublon") que tu appelleras à la fin de chaque code traitant les couleurs en mettant la ligne :
Run("Doublon")
Attention si le code traitant des couleurs fonctionne en l'état celui des doublons a besoin au préalable d'avoir l'onglet à traiter actif
Je ne sait pas si tous les Onglets comme pour les couleurs ont besoin d'être traité mais par onglet à traiter il faudra mettre :
Sheets("Onglet à traiter").Activate Par exemple pour l'Onglet "Général" il faut mettre : Sheets("Général").Activate Puis le code Doublon
Renouveler l'opération pour chaque Onglet concerné
L'ensemble de tout ces codes peuvent être mis l'un aprés l'autre dans une Macro
Mais si tous les Onglets sont à traiter je te préconise plustôt ce seul et unique code :
For k = 1 to Sheets.Count Sheets(k).Activate Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate Do While ActiveCell.Offset(-i, 0).Row > 1 For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i, 0).Row - 1, j) Then Divergence = 1 Exit For End If Next If Divergence <> 1 Then ActiveCell.Offset(-i, 0).EntireRow.Clear End If Divergence = "" i = i + 1 Loop Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A1").Activate Next
Si un onglet n'est pas à traiter tu peux mettre le code ci-dessus modifié ainsi :
For k = 1 to Sheets.Count If Sheets(k).Name <> "Nom de l'onglet à ne pas traiter" Sheets(k).Activate Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate Do While ActiveCell.Offset(-i, 0).Row > 1 For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i, 0).Row - 1, j) Then Divergence = 1 Exit For End If Next If Divergence <> 1 Then ActiveCell.Offset(-i, 0).EntireRow.Clear End If Divergence = "" i = i + 1 Loop Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A1").Activate End If Next
Le tout mis dans une seule Macro appelé "Doublon" que tu appellera à la fin de toutes tes Macros couleurs par la ligne :
Run("Doublon")
Espérant ne pas t'avoir noyé et répondu une fois de plus à ton attente
Dis moi !!!!
Bonjour,
Là j'avoue je suis noyé ...
lol
Les doublons sont à contrôler sur tous les onglets sur la colonne b & c ...
( Car la A est purement décorative )
@+
Romeo59181
"FFO" <FFO@discussions.microsoft.com> a écrit dans le message de groupe de
discussion : 626081EC-1502-438B-A6FC-18EBB2C7D51A@microsoft.com...
Rebonjour romero
Enfin content que tu sois satisfait
Pour faire fonctionner les 2 codes ensembles tu peux soit les mettre l'un
aprés l'autre dans chaque Macro traitant les couleurs soit mettre le code
traitant les doublons dans une nouvelle Macro ("Doublon") que tu
appelleras à
la fin de chaque code traitant les couleurs en mettant la ligne :
Run("Doublon")
Attention si le code traitant des couleurs fonctionne en l'état celui des
doublons a besoin au préalable d'avoir l'onglet à traiter actif
Je ne sait pas si tous les Onglets comme pour les couleurs ont besoin
d'être
traité mais par onglet à traiter il faudra mettre :
Sheets("Onglet à traiter").Activate
Par exemple pour l'Onglet "Général" il faut mettre :
Sheets("Général").Activate
Puis le code Doublon
Renouveler l'opération pour chaque Onglet concerné
L'ensemble de tout ces codes peuvent être mis l'un aprés l'autre dans une
Macro
Mais si tous les Onglets sont à traiter je te préconise plustôt ce seul et
unique code :
For k = 1 to Sheets.Count
Sheets(k).Activate
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate
Do While ActiveCell.Offset(-i, 0).Row > 1
For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column
If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i,
0).Row - 1, j) Then
Divergence = 1
Exit For
End If
Next
If Divergence <> 1 Then
ActiveCell.Offset(-i, 0).EntireRow.Clear
End If
Divergence = ""
i = i + 1
Loop
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Activate
Next
Si un onglet n'est pas à traiter tu peux mettre le code ci-dessus modifié
ainsi :
For k = 1 to Sheets.Count
If Sheets(k).Name <> "Nom de l'onglet à ne pas traiter"
Sheets(k).Activate
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate
Do While ActiveCell.Offset(-i, 0).Row > 1
For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column
If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i,
0).Row - 1, j) Then
Divergence = 1
Exit For
End If
Next
If Divergence <> 1 Then
ActiveCell.Offset(-i, 0).EntireRow.Clear
End If
Divergence = ""
i = i + 1
Loop
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Activate
End If
Next
Le tout mis dans une seule Macro appelé "Doublon" que tu appellera à la
fin
de toutes tes Macros couleurs par la ligne :
Run("Doublon")
Espérant ne pas t'avoir noyé et répondu une fois de plus à ton attente
Les doublons sont à contrôler sur tous les onglets sur la colonne b & c ... ( Car la A est purement décorative )
@+
Romeo59181
"FFO" a écrit dans le message de groupe de discussion :
Rebonjour romero
Enfin content que tu sois satisfait
Pour faire fonctionner les 2 codes ensembles tu peux soit les mettre l'un aprés l'autre dans chaque Macro traitant les couleurs soit mettre le code traitant les doublons dans une nouvelle Macro ("Doublon") que tu appelleras à la fin de chaque code traitant les couleurs en mettant la ligne :
Run("Doublon")
Attention si le code traitant des couleurs fonctionne en l'état celui des doublons a besoin au préalable d'avoir l'onglet à traiter actif
Je ne sait pas si tous les Onglets comme pour les couleurs ont besoin d'être traité mais par onglet à traiter il faudra mettre :
Sheets("Onglet à traiter").Activate Par exemple pour l'Onglet "Général" il faut mettre : Sheets("Général").Activate Puis le code Doublon
Renouveler l'opération pour chaque Onglet concerné
L'ensemble de tout ces codes peuvent être mis l'un aprés l'autre dans une Macro
Mais si tous les Onglets sont à traiter je te préconise plustôt ce seul et unique code :
For k = 1 to Sheets.Count Sheets(k).Activate Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate Do While ActiveCell.Offset(-i, 0).Row > 1 For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i, 0).Row - 1, j) Then Divergence = 1 Exit For End If Next If Divergence <> 1 Then ActiveCell.Offset(-i, 0).EntireRow.Clear End If Divergence = "" i = i + 1 Loop Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A1").Activate Next
Si un onglet n'est pas à traiter tu peux mettre le code ci-dessus modifié ainsi :
For k = 1 to Sheets.Count If Sheets(k).Name <> "Nom de l'onglet à ne pas traiter" Sheets(k).Activate Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate Do While ActiveCell.Offset(-i, 0).Row > 1 For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i, 0).Row - 1, j) Then Divergence = 1 Exit For End If Next If Divergence <> 1 Then ActiveCell.Offset(-i, 0).EntireRow.Clear End If Divergence = "" i = i + 1 Loop Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A1").Activate End If Next
Le tout mis dans une seule Macro appelé "Doublon" que tu appellera à la fin de toutes tes Macros couleurs par la ligne :
Run("Doublon")
Espérant ne pas t'avoir noyé et répondu une fois de plus à ton attente
Dis moi !!!!
FFO
Rebonjours à toi
Si tous les onglets sont à traiter Dans une nouvelle Macro appelé "Doublon" mets ce code :
For k = 1 To Sheets.Count Sheets(k).Activate Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate Do While ActiveCell.Offset(-i, 0).Row > 1 For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i, 0).Row - 1, j) Then Divergence = 1 Exit For End If Next If Divergence <> 1 Then ActiveCell.Offset(-i, 0).EntireRow.Clear End If Divergence = "" i = i + 1 Loop Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A1").Activate i = 0 Next
A la fin de chaque Macro de chaque Onglet traitant la répartition des lignes en fonction de leur couleur tu mets cette ligne :
Run("Doublon")
A chaque Macro d'Onglet les couleurs seront réparties et les doublons de tous les onglets seront supprimées grace à cette nouvelle Macro "Doublon" appelée en fin de la procédure
Une petite imperfection à la suppression des doublons En fait lorsqu'il y a doublon je vide la ligne du doublon puis en fin d'analyse je retrie toutes les données restantes de l'onglet pour les regrouper Le hic c'est que le format des lignes des données restantes ne suit pas donc tu as un Onglet sans doublon mais avec aprés les données regroupées un certain nombre de lignes avec du quadrillage
Est ce un problème pour toi ???? Dis moi !!!!
Rebonjours à toi
Si tous les onglets sont à traiter
Dans une nouvelle Macro appelé "Doublon" mets ce code :
For k = 1 To Sheets.Count
Sheets(k).Activate
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate
Do While ActiveCell.Offset(-i, 0).Row > 1
For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column
If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i,
0).Row - 1, j) Then
Divergence = 1
Exit For
End If
Next
If Divergence <> 1 Then
ActiveCell.Offset(-i, 0).EntireRow.Clear
End If
Divergence = ""
i = i + 1
Loop
Range("A2", "A" &
Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort
Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Activate
i = 0
Next
A la fin de chaque Macro de chaque Onglet traitant la répartition des lignes
en fonction de leur couleur tu mets cette ligne :
Run("Doublon")
A chaque Macro d'Onglet les couleurs seront réparties et les doublons de
tous les onglets seront supprimées grace à cette nouvelle Macro "Doublon"
appelée en fin de la procédure
Une petite imperfection à la suppression des doublons
En fait lorsqu'il y a doublon je vide la ligne du doublon puis en fin
d'analyse je retrie toutes les données restantes de l'onglet pour les
regrouper
Le hic c'est que le format des lignes des données restantes ne suit pas donc
tu as un Onglet sans doublon mais avec aprés les données regroupées un
certain nombre de lignes avec du quadrillage
Si tous les onglets sont à traiter Dans une nouvelle Macro appelé "Doublon" mets ce code :
For k = 1 To Sheets.Count Sheets(k).Activate Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).Activate Do While ActiveCell.Offset(-i, 0).Row > 1 For j = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Column If Cells(ActiveCell.Offset(-i, 0).Row, j) <> Cells(ActiveCell.Offset(-i, 0).Row - 1, j) Then Divergence = 1 Exit For End If Next If Divergence <> 1 Then ActiveCell.Offset(-i, 0).EntireRow.Clear End If Divergence = "" i = i + 1 Loop Range("A2", "A" & Range("A2").SpecialCells(xlCellTypeLastCell).Row).EntireRow.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("A1").Activate i = 0 Next
A la fin de chaque Macro de chaque Onglet traitant la répartition des lignes en fonction de leur couleur tu mets cette ligne :
Run("Doublon")
A chaque Macro d'Onglet les couleurs seront réparties et les doublons de tous les onglets seront supprimées grace à cette nouvelle Macro "Doublon" appelée en fin de la procédure
Une petite imperfection à la suppression des doublons En fait lorsqu'il y a doublon je vide la ligne du doublon puis en fin d'analyse je retrie toutes les données restantes de l'onglet pour les regrouper Le hic c'est que le format des lignes des données restantes ne suit pas donc tu as un Onglet sans doublon mais avec aprés les données regroupées un certain nombre de lignes avec du quadrillage