Automatiser des feuilles Excel

Bonjour,

J'ai un nombre impressionnant de données à rentrer pour le boulo dans un tableau excel.

Mais en plus de rentrer ces données dans un tableau général, il faut que je fasse 6 autres tableaux en fonction d'un texte qui sera présent dans chaque cellule d'une colonne.

En résumé, je suis à la recherche d'un moyen pour que dès qu'un mot (ou plusieurs) apparaît dans une colonne, la ligne entière soit copié dans une autre feuille.

J'ai essayé en créant une macro ou encore avec SI mais mes connaissances ne sont pas assez grande en excel...

J'espère que quelqu'un pourra m'aider.

Je vous remercie par avance, vous m'apporteriez une immense aide !!!

PS : j'utilise office pro 2010

Bonjour,

Comme tout ceci manque de précisions, je suis partis du principe que tu commence à remplir ta ligne par la colonne A et tu passe de colonne en colonne sur cette ligne puis arrivé à la colonne E, la proc contrôle si en colonne B se trouve un des mots clé, si c'est le cas, la ligne est récupérée par l'intermédiaire d'un tableau et inscrite sur la feuille "Feuil2" dans la première ligne vide trouvée. Adapte le nom de la feuille et la plage de colonnes utilisée ainsi que la colonne contenant les mots clé :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Tbl
    Dim NumLigne As Long

    'sur la colonne E (normalement en fin de saisie de la ligne)
    If Target.Column <> 5 Then Exit Sub

    'le contrôle des mots se fait sur la colonne B
    Select Case Target.Offset(, -3).Value

        'adapter les différents mots
        Case "Mot 1", "Mot 2", "Mot 3", "Mot 4" 'etc...

            'récupère les valeurs des cellules colonne A à E de la ligne où la cellule en colonne B vient de changer
            Tbl = Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Value '5 = E, à adapter...

            'adapter le nom de la feuille...
            With Worksheets("Feuil2")

                'première cellule vide en colonne A de la feuille de récup
                NumLigne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A

                'inscrit les différentes valeurs
                .Range(.Cells(NumLigne, 1), .Cells(NumLigne, UBound(Tbl, 2))) = Tbl

            End With

    End Select

End Sub

Hervé.

Bonjour Hervé,

Merci de me venir en aide.

En faite, je vais remplir exactement 4 colonnes, ligne par ligne. Si dans la colonne 3 apparaît un certain mot (pierre, paul, jacques...), je souhaiterais alors que toute la ligne soit copier puis collé dans une des autres feuilles.

J'aurai ainsi une feuille avec toutes les données que j'aurai saisie et d'autres feuilles avec seulement certaines lignes en fonction du mot qui sera apparu dans la colonne 3.

J'espère avoir été plus claire et plus précis...

Vraiment merci pour votre aide, j'ai vraiment un max de données à rentrer!

Cordialement,

John

Ceci devrait marcher une fois que tu auras adapter le nom de la feuille qui doit recevoir les données ainsi que les mots que tu cherche (remplacer Mot 1, Mot 2, Mot 3, etc... Ils ont servis pour le test !) :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Tbl
    Dim NumLigne As Long

    'sur la colonne D (normalement en fin de saisie de la ligne)
   If Target.Column <> 4 Then Exit Sub

    'le contrôle des mots se fait sur la colonne C
   Select Case Target.Offset(, -1).Value

        'adapter les différents mots
       Case "Mot 1", "Mot 2", "Mot 3", "Mot 4" 'etc...

            'récupère les valeurs des cellules colonne A à E de la ligne où la cellule en colonne B vient de changer
           Tbl = Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Value

            'adapter le nom de la feuille...
           With Worksheets("Feuil2")

                'première cellule vide en colonne A de la feuille de récup
               NumLigne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A

                'inscrit les différentes valeurs
               .Range(.Cells(NumLigne, 1), .Cells(NumLigne, UBound(Tbl, 2))) = Tbl

            End With

    End Select

End Sub

Hervé.

Merci beaucoup pour ta réponse.

Je vais essayer ce soir.

Je ne sais pas pourquoi, j'ai perdu ma première feuille de calcule en essayant de rentrer la macro . Donc je vais le faire un peu plus au calme ce soir.

Encore merci et je me permettrais de revenir te voir si jamais !!

John

Aucun problème !

Hervé.

Bonjour,

Bon après de multiple tentatives restées infructueuses, je me permets de revenir vers vous.

J'ai fait mes modifications dans visual basic, mais je n'arrive pas a l'exécuté et donc à savoir si cela fonctionne correctement...

Voici donc le code :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Tbl

Dim NumLigne As Long

If Target.Column <> 4 Then Exit Sub

Select Case Target.Offset(, -1).Value

Case "Superprivilège", "Privilège", "Chirographaire", "Banque", "Intragroupe"

Tbl = Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Value

With Worksheets("Superprivilège", "Privilège", "Chirographaire", "Banque", "Intragroupe")

NumLigne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A

.Range(.Cells(NumLigne, 1), .Cells(NumLigne, UBound(Tbl, 2))) = Tbl

End With

End Select

End Sub

Je vous remercie pour votre aide.

John

Bonjour,

Ce ne serait pas plutôt ceci que tu cherche à faire ? Inscrire la ligne dans la feuille concernée. Je ne l'ai pas précisé mais ce code est à mettre dans le module de la feuille où tu saisie les valeurs :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Tbl
    Dim NumLigne As Long

    If Target.Column <> 4 Then Exit Sub

    Select Case Target.Offset(, -1).Value

        Case "Superprivilège", "Privilège", "Chirographaire", "Banque", "Intragroupe"

            Tbl = Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Value

            With Worksheets(Target.Offset(, -1).Value)

                NumLigne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A
                .Range(.Cells(NumLigne, 1), .Cells(NumLigne, UBound(Tbl, 2))) = Tbl

            End With

    End Select

End Sub

Hervé.

Merci encore une fois, mais je ne comprends pas pourquoi cela ne fonctionne pas.

Je fais exactement un copier-coller du module dans :

Microsoft visual basic -> VBAPROJET -> Microsoft Excel Objets -> Feuil1(GENERAL).

La feuille de code s'ouvre et dedans se trouve le module mais rien ne se passe de plus. J'ai d'ores et déjà tapé 400 lignes et je n'en suis pas à la moitié! Ton aide m'est précieuse!

Par contre ma colonne 3 ne contient pas seulement les mots. Le problème peut-il venir de là?

John

Bonjour,

Je te poste un classeur exemple qui fonctionne enfin, qui fonctionne comme moi je vois l'affaire !

Hervé.

Whoua ça fonctionne !!!!!!

Désolé pour mon retard, je viens de m'y remettre. Merci énormément!!! Fou!!!

Par contre, petite question comment faire pour l'appliquer à tout ce que j'ai d'ores et déjà tapé?

Merci Beaucoup!

John

Bonjour,

A mettre dans un module standard puis exécuter la proc. Je te conseille de faire d'abords un test sur une copie de ton classeur pour vois si le résultat convient :

Sub TranfertDonnees()

    Dim Plage As Range
    Dim Cel As Range
    Dim Tbl
    Dim NumLigne As Long

    'défini la plage sur la colonne C de la feuille "Feuille_de_Saisie" à partir de C2
    With Worksheets("Feuille_de_Saisie")

        Set Plage = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp))

    End With

    'parcour la plage (colonne C)
    For Each Cel In Plage

        'récupère les valeurs des 4 cellules (A, B, C, D)
        Tbl = Worksheets("Feuille_de_Saisie").Range(Cel.Offset(, -2), Cel.Offset(, 1)).Value

        'inscription des valeurs dans la première ligne vide de la feuille concidérée
        With Worksheets(Cel.Value)

            NumLigne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Range(.Cells(NumLigne, 1), .Cells(NumLigne, UBound(Tbl, 2))) = Tbl

        End With

    Next Cel

End Sub

Hervé.

Bonjour Hervé,

J'ai un blocage au niveau de :

With Worksheets(Cel.Value)

Je ne sais pas ce que cela signifie.

Penses-tu que le fais que parfois il y a plus d'information que seulement "Banque", par exemple "Banque Privilège..." pourrais être la raison ?

J'ai cru remarquer que lorsque la colonne C contenait plus de mots, ou de mots "clés", la ligne ne se copiait pas...

Très cordialement,

Merci pour ton temps et ton aide.

John

Ps : J'ai créé plusieurs copies de mon fichier de saisie donc pas de problème si je perds celui sur lequel je fais les essais !

C'est quand même pas évident ces Macros !

Re,

Penses-tu que le fais que parfois il y a plus d'information que seulement "Banque", par exemple "Banque Privilège..." pourrais faire être la raison ?

C'est tout à fait ça,les cellules de la plage (colonne C) doivent contenir le nom exact des feuilles, une seule petite différence sur l'orthographe et une erreur est générée car le compilateur ne trouve pas la feuille !

J'ai cru remarquer que lorsque la colonne C contenait plus de mots, ou de mots "clés", la ligne ne se copiait pas..

effectivement, la fonction Select Case cherche la correspondance exacte donc si les mots contenus sont différents de ceux indiqués dans 'Case' ("Superprivilège", "Privilège", "Chirographaire", "Banque", "Intragroupe") ils sont ignorés. S'ils doit y en avoir plus, tu peux les ajouter à la suite mais attention à l'erreur générée par l'absence de la feuille correspondante.

Sinon, s'il doit y avoir un ensemble de mots qui se rapporte à une feuille, il faut voir d'envisager ces cas. Regarde le code qui suit et ajoute les différents mots clés qui te sont nécessaires (entre guillemets et séparés par des virgules) :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim NomFeuille As String
    Dim Tbl
    Dim NumLigne As Long

    If Target.Column <> 4 Then Exit Sub

    'défini le nom de la feuille cible en fonction des différents mots clés...
    Select Case Target.Offset(, -1).Value

        Case "Superprivilège", "Super_SuperPrivilège" 'etc...

            NomFeuille = "Superprivilège"

        Case "Privilège", "Banque privilège" 'etc...

            NomFeuille = "Privilège"

        Case "Chirographaire" 'etc...

            NomFeuille = "Chirographaire"

        Case "Banque" 'etc...

            NomFeuille = "Banque"

        Case "Intragroupe" 'etc...

            NomFeuille = "Intragroupe"

        Case Else 'si pas de correspondance, fin de procédure pour ne pas exécuter les lignes après End Select

            Exit Sub

    End Select

    Tbl = Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Value

    With Worksheets(NomFeuille)

        NumLigne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A
       .Range(.Cells(NumLigne, 1), .Cells(NumLigne, UBound(Tbl, 2))) = Tbl

    End With

End Sub

Hervé.

Parfait celui-ci fonctionne super bien.

J'ai rentré mes différents rangs pour mes feuilles... Parfait.

Par contre dans mon module standard (module 1 chez moi), lorsque je lance l'exécution, j'ai un blocage à ce niveau :

With Worksheets(Cel.Value)

Dois-je rentrer le nom de toutes mes feuilles comme pour le module de la feuille 1?

John

Tu adapte ce code-ci (dans Select Case...End Select) comme dans celui que tu viens de faire pour la procédure évènementielle "Worksheet_Change". Si un message s'affiche, c'est que tu as un mot qui n'est pas répertorié dans la liste des "Case" :

Sub TranfertDonnees()

    Dim NomFeuille As String
    Dim NumLigne As Long
    Dim Plage As Range
    Dim Cel As Range
    Dim Tbl
    Dim NumLigne As Long

    'défini la plage sur la colonne C de la feuille "Feuille_de_Saisie" à partir de C2
   With Worksheets("Feuille_de_Saisie")

        Set Plage = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp))

    End With

    'parcour la plage (colonne C)
   For Each Cel In Plage

        'récupère les valeurs des 4 cellules (A, B, C, D)
       Tbl = Worksheets("Feuille_de_Saisie").Range(Cel.Offset(, -2), Cel.Offset(, 1)).Value

        Select Case Cel.Value

            Case "Superprivilège", "Super_SuperPrivilège" 'etc...

                NomFeuille = "Superprivilège"

            Case "Privilège", "Banque privilège" 'etc...

                NomFeuille = "Privilège"

            Case "Chirographaire" 'etc...

                NomFeuille = "Chirographaire"

            Case "Banque" 'etc...

                NomFeuille = "Banque"

            Case "Intragroupe" 'etc...

                NomFeuille = "Intragroupe"

            Case Else 'si pas de correspondance, fin de procédure pour ne pas exécuter les lignes après End Select

                MsgBox "Attention, le mot '" & Cel.Value & "' situé à la ligne '" & Cel.Row & "' n'est pas répertorié dans la liste !"
                Exit Sub

        End Select

        'inscription des valeurs dans la première ligne vide de la feuille concidérée
       With Worksheets(NomFeuille)

            NumLigne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Range(.Cells(NumLigne, 1), .Cells(NumLigne, UBound(Tbl, 2))) = Tbl

        End With

    Next Cel

End Sub

Hervé.

BBBBBIIIIIIIIIIIIIIIIIIIIIIINNNNNNNNNNNGGGGGGGGGGGGGGGGGGOOOOOOOOOOOOO !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Se fut laborieux. Je te prie de bien vouloir m'excuser mais te remercie vraiment pour ton aide et ta patience !!

John