Extraire des données

[anna29]

Bonjour à tous

J'ai besoin de votre aide car ce que je veux faire dépasse largement mes compétences 🙄
Je souhaiterais extraire des données d'une tableau pour les copier sur une autre feuille du fichier.
J'ai joins un fichier pour que ce soit plus clair !
Dans le fichier il y a plusieurs villes et plusieurs noms : je voudrais que ceux qui habitent Brest soient "copiés" automatiquement dans l'onglet "Brest" et également pour les autres villes.

Merci à tous pour votre aide.

 

[Paritec]

Re : Extraire des données

bonjour ana29 le forum
il faut copier quoi? juste le nom ou quoi d'autre????
a+
papou😱

 

[anna29]

Re : Extraire des données

Bonjour Papou et merci pour cette réponse rapide !
En fait, il y aura Nom/prénom et n° de téléphone

 

[Paritec]

Re : Extraire des données

Re anna29 le forum
tu veux pas trou de suite nous mettre les noms prénoms même bidon comme cela on fera tout comme il faut, autrement tu n'arriveras pas à adapter
a+
papou😱

 

[anna29]

Re : Extraire des données

Re,

J'ai modifié mon fichier test. Donc il faut que la ligne entière soit recopiée dans l'onglet qui lui correspond.
Brest pour celui qui a un "1" dans Brest.
Merci encore.
Regarde la pièce jointe TEST.xlsx

 

[Robert]

Re : Extraire des données

Bonjour Anna, Papou, bonjour le forum,

En pièce jointe ton fichier modifié avec le code ci-dessous :

Sub Macro1()
Dim cel As Range 'déclare la variable cel (CELlule)
Dim col As Byte 'déclare la variable col (COLonne)
Dim o As Object 'déclare la variable o (Onglet)
Dim dest As Range 'déclare la variable dest (cellle de DESTination)
With Sheets("BASE") 'prend en compte l'onglet "BASE"
    For Each cel In .Range("B2:B" & .Cells(Application.Rows.Count, 2).End(xlUp).Row) 'boucle sur toutes les cellules éditée cel de la colonne B (=2)
        col = .Cells(cel.Row, Application.Columns.Count).End(xlToLeft).Column 'définit la colonne col
        If .Cells(1, col).Value <> "" Then 'condition : si la cellule de la ligne 1 n'est pas vide
            On Error Resume Next 'gestion des erreurs (en cas d'érreur passe à la ligne suivante)
            Set o = Sheets(.Cells(1, col).Value) 'définit l'onglet o (si c'est onglet n'existe pas cela provoque une erreur)
        Else 'sinon
            Exit Sub 'sort de la procédure
        End If 'fin de la condition
        If Err <> 0 Then 'condition 1 : si une erreur a été générée
            Err = 0 'annule l'erreur
            If MsgBox("L'onglet " & .Cells(1, col) & " n'existe pas ! Voulez-vous le créer ?", vbYesNo) = vbYes Then 'condition 2 : si "oui" au message
                Sheets.Add after:=Sheets(Sheets.Count) 'ajoute un onglet en dernier
                ActiveSheet.Name = .Cells(1, col).Value 'nomme l'onglet
                Set o = Sheets(.Cells(1, col).Value) 'définit l'onglet o
            End If 'fin de la condition 2
        End If 'fin de la condition 1
        'définit la cellule de destination A1 si A1 est vide, sinon la première cellule vide de la colonne A de l'onglet o
        Set dest = IIf(o.Range("A1").Value = "", o.Range("A1"), o.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
        cel.Copy dest 'copie la cellule et la colle dans dest
    Next cel 'prochaine cellule cel de la boucle
End With 'fin de la prise en compte de l'onglet "BASE"
End Sub

Le fichier :

[Édition]
Il faudra adapter pour le prénom ,etc...

 

[anna29]

Re : Extraire des données

Super merci !

Une dernière chose : si je rajoute des noms ou que je modifie la ville d'appartenance, les données vont se mettre en double.

 

[Paritec]

Re : Extraire des données

Bonjour Anna Robert😱 le forum
j'ai fait alors je poste
a+
papou😱

 

[Robert]

Re : Extraire des données

Bonjour le fil, bonjour le forum,

En pièce jointe une version 2 avec le code actualisé ci-dessous :

Sub Macro1()
Dim cel As Range 'déclare la variable cel (CELlule)
Dim col As Byte 'déclare la variable col (COLonne)
Dim o As Object 'déclare la variable o (Onglet)
Dim dest As Range 'déclare la variable dest (cellle de DESTination)

For Each o In Sheets 'boucle sur tous les onglets du classeur
    If o.Name <> "BASE" Then o.Cells.Clear 'si le nom de l'onglet est différents de "BASE" efface tout
Next o 'prochaine onglet de la boucle
With Sheets("BASE") 'prend en compte l'onglet "BASE"
    For Each cel In .Range("B2:B" & .Cells(Application.Rows.Count, 2).End(xlUp).Row) 'boucle sur toutes les cellules éditée cel de la colonne B (=2)
        col = .Cells(cel.Row, Application.Columns.Count).End(xlToLeft).Column 'définit la colonne col
        If .Cells(1, col).Value <> "" Then 'condition : si la cellule de la ligne 1 n'est pas vide
            On Error Resume Next 'gestion des erreurs (en cas d'érreur passe à la ligne suivante)
            Set o = Sheets(.Cells(1, col).Value) 'définit l'onglet o (si c'est onglet n'existe pas cela provoque une erreur)
        Else 'sinon
            Exit Sub 'sort de la procédure
        End If 'fin de la condition
        If Err <> 0 Then 'condition 1 : si une erreur a été générée
            Err = 0 'annule l'erreur
            If MsgBox("L'onglet " & .Cells(1, col) & " n'existe pas ! Voulez-vous le créer ?", vbYesNo) = vbYes Then 'condition 2 : si "oui" au message
                Sheets.Add after:=Sheets(Sheets.Count) 'ajoute un onglet en dernier
                ActiveSheet.Name = .Cells(1, col).Value 'nomme l'onglet
                Set o = Sheets(.Cells(1, col).Value) 'définit l'onglet o
            End If 'fin de la condition 2
        End If 'fin de la condition 1
        'définit la cellule de destination A1 si A1 est vide, sinon la première cellule vide de la colonne A de l'onglet o
        Set dest = IIf(o.Range("A1").Value = "", o.Range("A1"), o.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
        Range(cel, cel.Offset(0, 4)).Copy dest 'copie la cellule et la colle dans dest
    Next cel 'prochaine cellule cel de la boucle
End With 'fin de la prise en compte de l'onglet "BASE"
End Sub

Le fichier :

 

[anna29]

Re : Extraire des données

Merci à vous deux ! C'est exactement ça que je voulais !
Bonne fin de journée.
Anna