Extraire des données

  • Initiateur de la discussion Initiateur de la discussion anna29
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

anna29

XLDnaute Nouveau
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.
 

Pièces jointes

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
 

Pièces jointes

Re : Extraire des données

Bonjour Anna, Papou, bonjour le forum,

En pièce jointe ton fichier modifié avec le code ci-dessous :
Code:
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...


 

Pièces jointes

Re : Extraire des données

Bonjour le fil, bonjour le forum,

En pièce jointe une version 2 avec le code actualisé ci-dessous :
Code:
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 :
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
12
Affichages
624
Réponses
5
Affichages
131
Réponses
4
Affichages
146
Réponses
7
Affichages
281
Retour