Code alimentation colonnes

Bonjour chers experts.

Nouveau en matière de programmation vba. J'ai un classeur de deux (02) feuilles : Registre et Secteurs. Sur Registre, j'ai un tableau de plusieurs colonnes. Ce tableau enregistre les informations de sociétés. Dans la colonne 3 j'indique le secteur d'activité de la société (agro-alimentaire, chimie, services,... ). Sur Secteurs j'ai un tableau. Les colonnes sont les différents types de Secteurs d'activité. Je souhaite rédiger un code qui permet de classer dans chaque colonne le nom de la société en fonction du secteur d'activité indiqué dans Registre. Je voudrais que cela se fasse par report automatique, dès que j'enregistre une société. Aidez-moi pour le code svp.

Bonjour KitJean et

Une petite présentation ICI serait la bienvenue

Si vous ne l'avez pas encore fait, je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum

Ainsi que sur les fonctionnalités (Nouveau Forum au bas de page notamment)

Merci de renseigner votre version d'Excel dans votre profil

Merci de votre participation

Cordialement

Bonjour KitJean,

La solution que je propose utilise un Userform, c'est à dire que lorsque qu'on appui sur le bouton "ajouter" (voir PJ) une petite fenêtre de saisi s'affiche pour rentrer une société ainsi qu'un secteur

voici le code de l'userform :

Private Sub CommandButton1_Click()

Dim Cel As Range

For Each Cel In Range("A:A")
    If Cel.Value = "" Then
        Cel.Value = TextBox1.Value
        Exit For
    End If
Next Cel

For Each Cel In Range("B:B")
    If Cel.Value = "" Then
        Cel.Value = TextBox2.Value
        Exit For
    End If
Next Cel

If TextBox2.Value = Worksheets("Secteur").Range("A1").Value Then
    For Each Cel In Worksheets("Secteur").Range("A:A")
     If Cel.Value = "" Then
        Cel.Value = TextBox1.Value
        Exit For
    End If
    Next Cel
End If

If TextBox2.Value = Worksheets("Secteur").Range("B1").Value Then
    For Each Cel In Worksheets("Secteur").Range("B:B")
     If Cel.Value = "" Then
        Cel.Value = TextBox1.Value
        Exit For
    End If
    Next Cel
End If

If TextBox2.Value = Worksheets("Secteur").Range("C1").Value Then
    For Each Cel In Worksheets("Secteur").Range("C:C")
     If Cel.Value = "" Then
        Cel.Value = TextBox1.Value
        Exit For
    End If
    Next Cel
End If

Unload Me

End Sub

je te mets le fichier en pièce jointe pour que tu puisses tester et t'approprier le code.

En espérant que cela répond à ta requête

A+

PS : je te conseille de jeter un œil sur la partie cours, assez complète pour comprendre et débuter

Cours VBA : introduction (excel-pratique.com)

Bonjour Boshupp.

Merci pour vos réponses.

J'ai testé votre code. Il fonctionne; cependant, la feuille "Secteurs" n'est pas alimenté.

J'ai déjà écrit la partie du code qui enregistre les sociétés dans la feuille "Registre". Cela marche comme je le souhaite.

Mon challenge maintenant est d'ajouter un module qui va parcourir la colonne Secteur de la feuille "Registre". Par exemple, chaque fois qu'il trouve comme secteur : Electricité, il récupère le nom de la société qui est dans la colonne A (EDF p.e.) et il va inscrire EDF dans la colonne dont l'en-tête est Electricité dans la feuille "Secteurs". Ce module, je voudrais qu'il s'exécute avec un Workbook_open.

Bonjour

Pourquoi vouloir utiliser du VBA, alors que vous n'y connaissez rien

Une simple formule ne pourrait pas convenir

A+

Si tu as seulement copié collé le code que j'ai fais , il faut faire attention dans mon fichier j'ai appelé ma feuille "Secteur" et non "Secteurs"

Tu aurais pas un fichier à partager ?

Cela me permettrait de travailler directement sur ce que tu souhaites

Je viens de partager le fichier

KitJean,

Merci pour la mise à jour de votre profil

J'attends juste une réponse à ma question, évitez de snober le modo la prochaine fois

A+

Merci Modérateur. J'ai regardé votre proposition. Pourquoi recourir à du code? Je n'ai pas encore votre expertise. Je pensais que la solution se trouvais là. Concernant votre proposition, les lignes ne pourraient-elles pas être remplies entièrement, au lieu d'une colonne par ligne?

Bonsoir le fil, bonsoir le forum,

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

Private OS As Worksheet
Private TS As ListObject
Private OD As Worksheet
Private TD As ListObject

Private Sub UserForm_Initialize()
Set OS = Worksheets("Registre")
Set TS = OS.ListObjects("Tableau3")
Set OD = Worksheets("Secteurs")
Set TD = OD.ListObjects("Tableau1")
End Sub

Private Sub btnAjout_Click()
Dim R As Range
Dim LI As Integer
Dim CTRL As Control
Dim COL As Integer

Reponse1 = MsgBox("Enregistrer la saisie?", vbYesNo + vbQuestion, "DEMANDE DE CONFIRMATION D'AJOUT")
If Reponse1 = vbYes Then
    Set R = TS.ListColumns(1).Range.Find("")
    If R Is Nothing Or TS.ListRows.Count = 0 Then
        TS.ListRows.Add
        LI = TS.ListRows.Count
    Else
        LI = R.Row - TS.HeaderRowRange.Row
    End If
    For Each CTRL In Me.Controls
        If CTRL.Tag <> "" Then
            TS.DataBodyRange(LI, CInt(CTRL.Tag)).Value = CTRL.Value
        End If
    Next CTRL
End If
COL = TD.HeaderRowRange.Find(Me.cboSecteur.Value, , xlValues, xlWhole).Column
Set R = TD.ListColumns(COL).Range.Find("")
If R Is Nothing Or TD.ListRows.Count = 0 Then
    TD.ListRows.Add
    LI = TD.ListRows.Count
Else
    LI = R.Row - TD.HeaderRowRange.Row
End If
TD.DataBodyRange(LI, COL).Value = Me.txtNom.Value
ActiveWorkbook.RefreshAll
Unload Me
ActiveWorkbook.Save
End Sub

Private Sub BtnAnnuler_Click()
Reponse2 = MsgBox("Annulation de la saisie?", vbYesNo + vbQuestion, "DEMANDE DE CONFIRMATION D'ANNULATION")
If Reponse2 = vbYes Then
    Unload Me
    FrmSaisieRegistre.Show
End If
End Sub

Private Sub btnExit_Click()
ActiveWorkbook.RefreshAll
Unload Me
ActiveWorkbook.Save
End Sub

Le fichier :

Re,

Oops j'avais pas tout lu... Le code à l'ouverture du classeur :

Private Sub Workbook_Open() 'à l'ouverture du classeur
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim TS As ListObject 'déclare la variable TS (Tableau structuré Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TD As ListObject 'déclare la variable TD (Tableau structuré Destination)
Dim I As Integer 'déclare la variable I (Incrément)
Dim COL As Byte 'déclare la variable COL (COLonne)
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI (LIgne)

Set OS = Worksheets("Registre") 'définit l'onglet source OS
Set TS = OS.ListObjects("Tableau3") 'définit le tableau structuré source TS
Set OD = Worksheets("Secteurs") 'définit l'onglet destination OD
Set TD = OD.ListObjects("Tableau1") 'définit le tableau structuré destination TD
If TD.ListRows.Count > 0 Then TD.DataBodyRange.Delete 'efface les anciennes données du tableau structuré TD si il contient au moins une ligne
For I = 1 To TS.ListRows.Count 'boucle sur toutes les lignes I du tableau structuré TS
    If TS.DataBodyRange(I, 1).Value <> "" Then 'condition : si la donnée ligne I colonne 1 de TS n'est pas vide
        'définit la colonne COL (recherche le secteur de TS dans la ligne d'en-tête de TD)
        COL = TD.HeaderRowRange.Find(TS.DataBodyRange(I, 3).Value, , xlValues, xlWhole).Column
        Set R = TD.ListColumns(COL).Range.Find("") 'définit la recher R (recherche du vide dans la colonne COL de TD)
        If R Is Nothing Or TD.ListRows.Count = 0 Then 'si aucune occurrence n'est trouvée ou si TD ne contient aucune ligne
            TD.ListRows.Add 'ajoute une ligne à TD
            LI = TD.ListRows.Count 'definit la ligne LI (dernière ligne de TD
        Else 'sinon (au moins une occurrence trouvée)
            LI = R.Row - TD.HeaderRowRange.Row 'définit la ligne LI (ligne de la première occurrence trouvée moins la ligne des en-têtes de TS)
        End If 'fin de la condition
        'renvoie dans les données de TD ligne LI colonne COL la donnée de TS ligne I colonne 1
        TD.DataBodyRange(LI, COL).Value = TS.DataBodyRange(I, 1).Value
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
End Sub

merci infiniment pour votre proposition. Je vous tiens informé bientôt, une fois que je me serai mis sur ma machine.

Bonjour ThauThème

Je viens d'ouvrir le fichier joint mais je n'ai vu aucune modification.

Re,

Heu... Dans le fichier joint (Kitjean-ed-v01.xlsm) il n'y avait pas le code Workbook_Open dans le composant ThisWorkbook que je t'ai proposé dans le post suivant. Le remplissage du Tableau1 se faisait sur le bouton Ajouter de l'UserForm FrmSaisieRegistre.
En fait, ça me paraît plus logique que de le faire à l'ouverture du fichier car il faut d'abord tout effacer, puis tout remettre. Mais bon... J'ai dû changer aussi la couleur de la police dans le Tableau1 (blanc sur fond bleu clair c'est pas top...) .

Sinon cours vite à la pharmacie pour acheter du collyre et ouvre le fichier en pièce jointe.

Non, je vais devoir consulter mon ophtalmo pour les verres!

Merci! très cher. Je regarde.

Cher ThauThème. Je vous remercie pour les deux solutions proposées. Elles règlent mon problème. MERCI!!