VBA EXCEL: Extraction des noms sans doublons

[Aragon10]

Bonjour,

Je dispose d'une feuille Excel qui contient des noms sur la colonne 2 (avec doublons). je veux créer une macro qui m'insère des nouvelles feuilles avec les noms disponibles(nouvelles feuilles sans doublons).
Après avoir créer ces feuilles par noms, je veux copier les lignes qui correspond à chaque nom. par exemple si la cellule "B2" est égale au nom d'une de ces feuilles récemment crées il y'aura copier/coller de toute la ligne de la feuille source vers sa feuille correspondante jusqu'à cellule non vide.

Merci pour votre aide précieuse.

 

[DoubleZero]

Re : VBA EXCEL: Extraction des noms sans doublons

Bonjour, Aragon10, le Forum,

Le filtre avancé devrait permettre d'obtenir le résultat souhaité.

Merci de bien vouloir déposer un exemple du fichier de travail, sans donnée confidentielle.

A bientôt

 

[Aragon10]

Re : VBA EXCEL: Extraction des noms sans doublons

Bonjour, Aragon10, le Forum,

Le filtre avancé devrait permettre d'obtenir le résultat souhaité.

Merci de bien vouloir déposer un exemple du fichier de travail, sans donnée confidentielle.

A bientôt

Bonsoir

veuillez trouver ci-joint un exemple de fichier source et le résultat souhaité.
Regarde la pièce jointe Fichier source.xlsxRegarde la pièce jointe Resultat.xlsx

Merci beaucoup

 

[BOISGONTIER]

Re : VBA EXCEL: Extraction des noms sans doublons

Bonjour,

cf PJ

JB

 

[DoubleZero]

Re : VBA EXCEL: Extraction des noms sans doublons

Bonjour, Aragon10, BOISGONTIER , le Forum,

Une autre suggestion en pièce jointe.

A bientôt

 

[Aragon10]

Re : VBA EXCEL: Extraction des noms sans doublons

Bonjour,

Je vous remercie énormément pour vos réponses.

une dernière question: j'ai des noms qui sont supérieurs à 32 caractères ce qui rend impossible le renommage des feuilles. Existe t'il un code pour retenir que 32 caractères pour les noms qui sont sup ?

ci dessous mon code un peu rectifié:

Sub Extrait()
  
Application.DisplayAlerts = False
For i = Sheets.Count To 2 Step -1
Sheets(i).Delete
Next i
Application.DisplayAlerts = True
 
  
Worksheets("BD").Range("G2:G" & Range("G65536").End(xlUp).Row).ClearContents    'efface
    Worksheets("BD").Select
    Range("A1").Select
    Range("B1:B" & Range("A65536").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("BD").Range("G1"), Unique:=True

Set f = Sheets("BD")
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
    
  For Each c In f.Range("G2:G" & f.[G65000].End(xlUp).Row) ' pour chaque service
    f.[G2] = c.Value
    On Error Resume Next
    Sheets(c.Value).Delete
    On Error GoTo 0
    Sheets.Add After:=Sheets(Sheets.Count) ' création
    ActiveSheet.Name = c.Value
    '-- extraction
    f.[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[G1:G2], CopyToRange:=[A1]
  Next c
  
End Sub

Merci pour votre aide

 

[BOISGONTIER]

Re : VBA EXCEL: Extraction des noms sans doublons

Bonjour,

Sub Extrait()
  Set f = Sheets("BD")
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  '--- Liste des noms
  f.[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=f.[G1], Unique:=True
  For Each c In f.Range("G2:G" & f.[G65000].End(xlUp).Row) ' pour chaque nom
    tmp = Left(c.Value, 31)
    f.[G2] = tmp & "*"
    On Error Resume Next
    Sheets(tmp).Delete
    On Error GoTo 0
    Sheets.Add After:=Sheets(Sheets.Count) ' création
    ActiveSheet.Name = tmp
    '-- extraction
    f.[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[G1:G2], CopyToRange:=[A1]
  Next c
End Sub

JB

 

[Aragon10]

Re : VBA EXCEL: Extraction des noms sans doublons

Merci beaucoup )