OVH Cloud OVH Cloud

Extraire plage de cellules dans une nouvelle feuille

9 réponses
Avatar
Nadyajah
Bonjour à tous,

J'ai une feuille nommée "Fichier client" avec les champs suivants :
A:N° Salon - B:N° Client - C:Civilité - D:Nom Client - E:Prénom Client -
F:Adresse 1...

J'ai créé une macro pour copier dans une nouvelle feuille "Fichier client à
rectifier" la liste des doublons de noms présents dans ma feuille "Fichier
client".

Cependant, je souhaiterais les extraire COMPLETEMENT de ma feuille "Fichier
client" pour les copier dans la feuille "Fichier client à rectifier" afin de
les vérifier.

Si l'extration n'était finalement pas nécessaire, je souhaiterais créer une
macro pour réintégrer la ligne sur laquelle je suis positionnée dans la
feuille "Fichier client à rectifier" dans la feuille "Fichier client". (Pas
forcement à sa place initiale cela n'a pas d'importance, elle peut être
placée à la fin de ma liste de clients, je peux faire un tri par la suite).

Merci pour votre aide à tous !!!

Nadyajah


Voici ma macro :
Sub ExtraitResultat()
Sheets("Fichier client à rectifier").Activate
Range("A1").Select
Sheets("Fichier client").Range("A1:I2000").AdvancedFilter Action:= _
xlFilterCopy, criteriarange:=Sheets("Fichier
client").Range("AC1:AC2" _
), copytorange:=Range("A1"), unique:=False
End Sub

Et la formule placée en AC1:AC2:
=SOMMEPROD(($D$2:$D$2000=D2)*($E$2:$E$2000=E2))>1

9 réponses

Avatar
Daniel
Bonjour.
Pour supprimer les doublons, j'ai trouvé plus simple de réécrire la macro :

Sub SuppressionClients()
Dim Derligne As Long
Dim Tabl() As String, Ctr As Long
Dim Ligne As Long
ReDim Tabl(0)
Ligne = 1
Derligne = Range("D65536").End(xlUp).Row
For i = Derligne To 2 Step -1
Var = Application.Match(Range("D" & i), Tabl, 0)
If IsError(Var) Then
ReDim Preserve Tabl(Ctr)
Tabl(Ctr) = Range("D" & i).Value
Ctr = Ctr + 1
Else
Var = Range("D" & i)
Range("A" & i & ":I" & i).Copy _
Sheets("Fichier client à rectifier").Range("A" & Ligne)
Ligne = Ligne + 1
Range("D" & i).EntireRow.Delete
End If
Next i
End Sub

Pour réincorporer les clients :

Sub ReincorporationClient()
Dim Ligne As Long
Sheets("Fichier client").Select
Ligne = Range("A65536").End(xlUp).Row + 1
Sheets("Fichier client à rectifier").Select
Range("A" & ActiveCell.Row & ":I" & ActiveCell.Row).Copy _
Sheets("Fichier client").Range("A" & Ligne)
ActiveCell.EntireRow.Delete
End Sub

Cordialement.
Daniel
"Nadyajah" a écrit dans le message de
news:
Bonjour à tous,

J'ai une feuille nommée "Fichier client" avec les champs suivants :
A:N° Salon - B:N° Client - C:Civilité - D:Nom Client - E:Prénom Client -
F:Adresse 1...

J'ai créé une macro pour copier dans une nouvelle feuille "Fichier client
à
rectifier" la liste des doublons de noms présents dans ma feuille "Fichier
client".

Cependant, je souhaiterais les extraire COMPLETEMENT de ma feuille
"Fichier
client" pour les copier dans la feuille "Fichier client à rectifier" afin
de
les vérifier.

Si l'extration n'était finalement pas nécessaire, je souhaiterais créer
une
macro pour réintégrer la ligne sur laquelle je suis positionnée dans la
feuille "Fichier client à rectifier" dans la feuille "Fichier client".
(Pas
forcement à sa place initiale cela n'a pas d'importance, elle peut être
placée à la fin de ma liste de clients, je peux faire un tri par la
suite).

Merci pour votre aide à tous !!!

Nadyajah


Voici ma macro :
Sub ExtraitResultat()
Sheets("Fichier client à rectifier").Activate
Range("A1").Select
Sheets("Fichier client").Range("A1:I2000").AdvancedFilter Action:= _
xlFilterCopy, criteriarange:=Sheets("Fichier
client").Range("AC1:AC2" _
), copytorange:=Range("A1"), unique:úlse
End Sub

Et la formule placée en AC1:AC2:
=SOMMEPROD(($D$2:$D$2000Ò)*($E$2:$E$2000â))>1


Avatar
Nadyajah
Bonsoir,

Tout d'abord merci pour votre aide !!
Cependant, concernant la fonction qui permet d'extraire les doublons, elle
extrait uniquement les noms de famille identique (et 1 seul). Par exemple :

MARTIN PIERRE
DURAND YVES
MARTIN EVELYNE
DUPONT MARIE
MARTIN EVELYNE

La fonction va me sortir :
MARTIN PIERRE
uniquement dans ma feuille "Fichier client à rectifier" alors que je
voudrais qu'il me sorte :
MARTIN EVELYNE
MARTIN EVELYNE
(les 2 noms pour pouvoir vérifier si l'adresse est identique)
C'est pour cela que j'avais créer :
=SOMMEPROD(($D$2:$D$2000Ò)*($E$2:$E$2000â))>1

Cordialement.

Nadyajah
Avatar
AV
Connais-tu le filtre élaboré avec "extraction sans doublon" ?
A partir de là... pas mal de choses s'éclairent

AV
Avatar
Daniel
Bonjour.
Donc rectification :

Sub SuppressionClients()
Dim Plage As Range, c As Range, Ligne As Long
Columns(10).Insert
Ligne = 1
Set Plage = Range("D2", Range("D65536").End(xlUp))
For Each c In Plage
c.Offset(0, 6).Value = c.Value & c.Offset(0, 1).Value
Next c
For Each c In Plage
If WorksheetFunction.CountIf(Plage.Offset(0, 6), c.Offset(0, 6)) > 1
Then
Range("A" & c.Row & ":I" & c.Row).Copy _
Sheets("Fichier client à rectifier").Range("A" & Ligne)
Ligne = Ligne + 1
c.EntireRow.Delete
End If
Next c
Range("J:J").Delete
End Sub

Cordialement.
Daniel
"Nadyajah" a écrit dans le message de
news:
Bonsoir,

Tout d'abord merci pour votre aide !!
Cependant, concernant la fonction qui permet d'extraire les doublons, elle
extrait uniquement les noms de famille identique (et 1 seul). Par exemple
:

MARTIN PIERRE
DURAND YVES
MARTIN EVELYNE
DUPONT MARIE
MARTIN EVELYNE

La fonction va me sortir :
MARTIN PIERRE
uniquement dans ma feuille "Fichier client à rectifier" alors que je
voudrais qu'il me sorte :
MARTIN EVELYNE
MARTIN EVELYNE
(les 2 noms pour pouvoir vérifier si l'adresse est identique)
C'est pour cela que j'avais créer :
=SOMMEPROD(($D$2:$D$2000Ò)*($E$2:$E$2000â))>1

Cordialement.

Nadyajah


Avatar
Nadyajah
Bonsoir Daniel,

La fonction ne m'extrait qu'un seul des doublons dans ma feuille 'Fichier
client à rectifier' .....


Bonjour.
Donc rectification :

Sub SuppressionClients()
Dim Plage As Range, c As Range, Ligne As Long
Columns(10).Insert
Ligne = 1
Set Plage = Range("D2", Range("D65536").End(xlUp))
For Each c In Plage
c.Offset(0, 6).Value = c.Value & c.Offset(0, 1).Value
Next c
For Each c In Plage
If WorksheetFunction.CountIf(Plage.Offset(0, 6), c.Offset(0, 6)) > 1
Then
Range("A" & c.Row & ":I" & c.Row).Copy _
Sheets("Fichier client à rectifier").Range("A" & Ligne)
Ligne = Ligne + 1
c.EntireRow.Delete
End If
Next c
Range("J:J").Delete
End Sub

Cordialement.
Daniel
"Nadyajah" a écrit dans le message de
news:
Bonsoir,

Tout d'abord merci pour votre aide !!
Cependant, concernant la fonction qui permet d'extraire les doublons, elle
extrait uniquement les noms de famille identique (et 1 seul). Par exemple
:

MARTIN PIERRE
DURAND YVES
MARTIN EVELYNE
DUPONT MARIE
MARTIN EVELYNE

La fonction va me sortir :
MARTIN PIERRE
uniquement dans ma feuille "Fichier client à rectifier" alors que je
voudrais qu'il me sorte :
MARTIN EVELYNE
MARTIN EVELYNE
(les 2 noms pour pouvoir vérifier si l'adresse est identique)
C'est pour cela que j'avais créer :
=SOMMEPROD(($D$2:$D$2000Ò)*($E$2:$E$2000â))>1

Cordialement.

Nadyajah







Avatar
Daniel
Bonjour.
Alors essaie :

Sub SuppressionClients()
Dim Plage As Range, c As Range, Ligne As Long
Range("J:K").Insert
Ligne = 1
Set Plage = Range("D2", Range("D65536").End(xlUp))
For Each c In Plage
c.Offset(0, 6).Value = c.Value & c.Offset(0, 1).Value
Next c
For Each c In Plage
c.Offset(0, 7).Value = _
WorksheetFunction.CountIf(Plage.Offset(0, 6), c.Offset(0, 6))
Next c
Range("k:k").Copy
Range("k:k").PasteSpecial xlPasteValues
For Each c In Plage
If c.Offset(0, 7).Value > 1 Then
Range("A" & c.Row & ":I" & c.Row).Copy _
Sheets("Fichier client à rectifier").Range("A" & Ligne)
Ligne = Ligne + 1
c.EntireRow.Delete
End If
Next c
Range("J:K").Delete
End Sub

Cordialement.
Daniel
"Nadyajah" a écrit dans le message de
news:
Bonsoir Daniel,

La fonction ne m'extrait qu'un seul des doublons dans ma feuille 'Fichier
client à rectifier' .....


Bonjour.
Donc rectification :

Sub SuppressionClients()
Dim Plage As Range, c As Range, Ligne As Long
Columns(10).Insert
Ligne = 1
Set Plage = Range("D2", Range("D65536").End(xlUp))
For Each c In Plage
c.Offset(0, 6).Value = c.Value & c.Offset(0, 1).Value
Next c
For Each c In Plage
If WorksheetFunction.CountIf(Plage.Offset(0, 6), c.Offset(0, 6))
1
Then

Range("A" & c.Row & ":I" & c.Row).Copy _
Sheets("Fichier client à rectifier").Range("A" & Ligne)
Ligne = Ligne + 1
c.EntireRow.Delete
End If
Next c
Range("J:J").Delete
End Sub

Cordialement.
Daniel
"Nadyajah" a écrit dans le message
de
news:
Bonsoir,

Tout d'abord merci pour votre aide !!
Cependant, concernant la fonction qui permet d'extraire les doublons,
elle
extrait uniquement les noms de famille identique (et 1 seul). Par
exemple
:

MARTIN PIERRE
DURAND YVES
MARTIN EVELYNE
DUPONT MARIE
MARTIN EVELYNE

La fonction va me sortir :
MARTIN PIERRE
uniquement dans ma feuille "Fichier client à rectifier" alors que je
voudrais qu'il me sorte :
MARTIN EVELYNE
MARTIN EVELYNE
(les 2 noms pour pouvoir vérifier si l'adresse est identique)
C'est pour cela que j'avais créer :
=SOMMEPROD(($D$2:$D$2000Ò)*($E$2:$E$2000â))>1

Cordialement.

Nadyajah









Avatar
Nadyajah
Bonsoir Daniel,

La fonction marche cependant elle met prêt de 5 minutes à terminer un
fichier de 1000 lignes alors que ma précédente fonction ne mettait qu'une
vingtaine de secondes. En connais-tu la raison?
Merci d'avance.

Nadyajah


Bonjour.
Alors essaie :

Sub SuppressionClients()
Dim Plage As Range, c As Range, Ligne As Long
Range("J:K").Insert
Ligne = 1
Set Plage = Range("D2", Range("D65536").End(xlUp))
For Each c In Plage
c.Offset(0, 6).Value = c.Value & c.Offset(0, 1).Value
Next c
For Each c In Plage
c.Offset(0, 7).Value = _
WorksheetFunction.CountIf(Plage.Offset(0, 6), c.Offset(0, 6))
Next c
Range("k:k").Copy
Range("k:k").PasteSpecial xlPasteValues
For Each c In Plage
If c.Offset(0, 7).Value > 1 Then
Range("A" & c.Row & ":I" & c.Row).Copy _
Sheets("Fichier client à rectifier").Range("A" & Ligne)
Ligne = Ligne + 1
c.EntireRow.Delete
End If
Next c
Range("J:K").Delete
End Sub

Cordialement.
Daniel
"Nadyajah" a écrit dans le message de
news:
Bonsoir Daniel,

La fonction ne m'extrait qu'un seul des doublons dans ma feuille 'Fichier
client à rectifier' .....


Bonjour.
Donc rectification :

Sub SuppressionClients()
Dim Plage As Range, c As Range, Ligne As Long
Columns(10).Insert
Ligne = 1
Set Plage = Range("D2", Range("D65536").End(xlUp))
For Each c In Plage
c.Offset(0, 6).Value = c.Value & c.Offset(0, 1).Value
Next c
For Each c In Plage
If WorksheetFunction.CountIf(Plage.Offset(0, 6), c.Offset(0, 6))
1
Then

Range("A" & c.Row & ":I" & c.Row).Copy _
Sheets("Fichier client à rectifier").Range("A" & Ligne)
Ligne = Ligne + 1
c.EntireRow.Delete
End If
Next c
Range("J:J").Delete
End Sub

Cordialement.
Daniel
"Nadyajah" a écrit dans le message
de
news:
Bonsoir,

Tout d'abord merci pour votre aide !!
Cependant, concernant la fonction qui permet d'extraire les doublons,
elle
extrait uniquement les noms de famille identique (et 1 seul). Par
exemple
:

MARTIN PIERRE
DURAND YVES
MARTIN EVELYNE
DUPONT MARIE
MARTIN EVELYNE

La fonction va me sortir :
MARTIN PIERRE
uniquement dans ma feuille "Fichier client à rectifier" alors que je
voudrais qu'il me sorte :
MARTIN EVELYNE
MARTIN EVELYNE
(les 2 noms pour pouvoir vérifier si l'adresse est identique)
C'est pour cela que j'avais créer :
=SOMMEPROD(($D$2:$D$2000Ò)*($E$2:$E$2000â))>1

Cordialement.

Nadyajah














Avatar
Nadyajah
Re,

J'ai trouvé pourquoi. J'avais une formule dans une autre colonne qui se
remettait à tout recalculer.
Tout fonctionne correctement maintenant.
Je te remercie encore énormément pour ton aide.
A bientôt.

Nadyajah


Bonsoir Daniel,

La fonction marche cependant elle met prêt de 5 minutes à terminer un
fichier de 1000 lignes alors que ma précédente fonction ne mettait qu'une
vingtaine de secondes. En connais-tu la raison?
Merci d'avance.

Nadyajah


Bonjour.
Alors essaie :

Sub SuppressionClients()
Dim Plage As Range, c As Range, Ligne As Long
Range("J:K").Insert
Ligne = 1
Set Plage = Range("D2", Range("D65536").End(xlUp))
For Each c In Plage
c.Offset(0, 6).Value = c.Value & c.Offset(0, 1).Value
Next c
For Each c In Plage
c.Offset(0, 7).Value = _
WorksheetFunction.CountIf(Plage.Offset(0, 6), c.Offset(0, 6))
Next c
Range("k:k").Copy
Range("k:k").PasteSpecial xlPasteValues
For Each c In Plage
If c.Offset(0, 7).Value > 1 Then
Range("A" & c.Row & ":I" & c.Row).Copy _
Sheets("Fichier client à rectifier").Range("A" & Ligne)
Ligne = Ligne + 1
c.EntireRow.Delete
End If
Next c
Range("J:K").Delete
End Sub

Cordialement.
Daniel
"Nadyajah" a écrit dans le message de
news:
Bonsoir Daniel,

La fonction ne m'extrait qu'un seul des doublons dans ma feuille 'Fichier
client à rectifier' .....


Bonjour.
Donc rectification :

Sub SuppressionClients()
Dim Plage As Range, c As Range, Ligne As Long
Columns(10).Insert
Ligne = 1
Set Plage = Range("D2", Range("D65536").End(xlUp))
For Each c In Plage
c.Offset(0, 6).Value = c.Value & c.Offset(0, 1).Value
Next c
For Each c In Plage
If WorksheetFunction.CountIf(Plage.Offset(0, 6), c.Offset(0, 6))
1
Then

Range("A" & c.Row & ":I" & c.Row).Copy _
Sheets("Fichier client à rectifier").Range("A" & Ligne)
Ligne = Ligne + 1
c.EntireRow.Delete
End If
Next c
Range("J:J").Delete
End Sub

Cordialement.
Daniel
"Nadyajah" a écrit dans le message
de
news:
Bonsoir,

Tout d'abord merci pour votre aide !!
Cependant, concernant la fonction qui permet d'extraire les doublons,
elle
extrait uniquement les noms de famille identique (et 1 seul). Par
exemple
:

MARTIN PIERRE
DURAND YVES
MARTIN EVELYNE
DUPONT MARIE
MARTIN EVELYNE

La fonction va me sortir :
MARTIN PIERRE
uniquement dans ma feuille "Fichier client à rectifier" alors que je
voudrais qu'il me sorte :
MARTIN EVELYNE
MARTIN EVELYNE
(les 2 noms pour pouvoir vérifier si l'adresse est identique)
C'est pour cela que j'avais créer :
=SOMMEPROD(($D$2:$D$2000Ò)*($E$2:$E$2000â))>1

Cordialement.

Nadyajah
















Avatar
Nadyajah
Bonsoir,

En fait je viens de me rendre compte qu'il ne m'extrait pas tout les
doublons...
Je n'y comprend plus rien.
J'ai joint le fichier pour test
http://cjoint.com/?cex6Vw7kHI

Nadyajah