Copier cellule via liste déroulante

Bonjour le forum,

Pour un projet de mise en place d'une base de données pour faire du publipostage, il faudrait qu'un utilisateur choisisse une valeur dans une liste déroulante (à savoir : publi simple, publi multiple) et qu'en fonction de celle-ci certaines cellules soient copier dans la feuille en question.

Je vous joint mon fichier pour plus de détails.

Vous remerciant par avance de votre aide.

Bonne journée.

Bonjour Samsam, bonjour le forum,

Ce que tu demandes n'est pas bien compliqué mais à quel moment voudrais-tu que les données soient transférées :

• Si tu le fais au changement dans la cellule de la validation de données de la colonne J que se passera-t-il si un utilisateur se trompe et change d'avis ou si il efface le contenu de cette cellule ?

• Je verrais bien un bouton. Au clic dans celui-ci, il commencerait par effacer le continu des deux onglets publi simple et publi multiple. Puis repasserait toutes les lignes de l'onglet Feuil1 pour faire le dispatching.

Le code :

Sub Macro1()
Dim S As Worksheet 'déclare la variable S (onglet publi Simple)
Dim M As Worksheet 'déclare la variable M (onglet publi Multiple)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément de ligne)
Dim J As Byte 'déclare la variable J (incrément de colonne)
Dim K As Byte 'déclare la variable K (incrément de colonne)
Dim LS As Integer 'déclare la variable LS (incrément de colonnee tu tableau TS)
Dim LM As Integer 'déclare la variable LM (incrément de colonnee tu tableau TM)
Dim TS() As Variant 'déclare la variable TS (Tableau des publi Simples)
Dim TM() As Variant 'déclare la variable TM (Tableau des publi Multiples)

Set S = Sheets("publi simple") 'définit l'onglet S
Set M = Sheets("publi multiple") 'définit l'onglet M
TV = Sheets("Feuil1").Range("A1").CurrentRegion 'définit le tableau des valeurs TV
'si A2 de l'onglet S n'est pas vide, efface les anciennes données de l'onglet S
If S.Range("A2").Value <> "" Then S.Range("A2:H" & S.Range("A" & Application.Rows.Count).End(xlUp).Row).ClearContents
'si A2 de l'onglet M n'est pas vide, efface les anciennes données de l'onglet M
If M.Range("A2").Value <> "" Then M.Range("A2:H" & M.Range("A" & Application.Rows.Count).End(xlUp).Row).ClearContents
LS = 1 'initialise la variable LS
LM = 1 'initialise la variable LM
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes du tableau des valeurs TV (en partant de la seconde)
    Select Case TV(I, 10) 'agit en fonction de la données ligne I colonne 10 de TV (=> colonne J)
        Case "publi simple" 'cas "publi simple"
            For J = 1 To 8 'boucle 2 sur les 8 lignes de TS
                K = IIf(J > 3, J + 1, J) 'définit K en fonction de J (K=J puis quand J est > à 3, K=J+1)
                ReDim Preserve TS(1 To 8, 1 To LS) 'redimensionne le tableau TS (8 lignes, LS colonnes)
                'récupère dans la ligne J colonne LS de TS la valeur ligne I colonne K de TV (transposition)
                TS(J, LS) = TV(I, K)
            Next J 'prochaine ligne de la boucle 2
            LS = LS + 1 'incrément LS (ajoute une colonne au tableau TS)
        Case "publi multiple" 'cas "publi multiple"
            For J = 1 To 8 'boucle 2 sur les 8 lignes de TS
                K = IIf(J > 3, J + 1, J) 'définit K en fonction de J (K=J puis quand J est > à 3, K=J+1)
                ReDim Preserve TM(1 To 8, 1 To LM) 'redimensionne le tableau Tm (8 lignes, Lm colonnes)
                'récupère dans la ligne J colonne LM de TM la valeur ligne I colonne K de TV (transposition)
                TM(J, LM) = TV(I, K)
            Next J 'prochaine ligne de la boucle 2
            LM = LM + 1 'incrément LM (ajoute une colonne au tableau TM)
    End Select 'fin de l'action en fonction de la données ligne I colonne 10 de TV (=> colonne J)
Next I 'prochaine ligne de la boucle 1
If LS > 1 Then 'condition : si KS est supérieur à 1
    'renvoie dans A2 (redimensionnée) de l'onglet S le tableau TS transposé
    S.Range("A2").Resize(UBound(TS, 2), UBound(TS, 1)).Value = Application.Transpose(TS)
End If 'fin de la condition
If LM > 1 Then
    'renvoie dans A2 (redimensionnée) de l'onglet M le tableau TM transposé
    M.Range("A2").Resize(UBound(TM, 2), UBound(TM, 1)).Value = Application.Transpose(TM)
End If 'fin de la condition
End Sub

Le fichier :

bonjour

un essai sans vba (pour ceux qui ny ont pas droit)

cordialement

Bonjour samsam07, Thau Theme, tulipe4, le forum,

Une solution par arrray (moins sophistiquée que celle proposée par Thau Theme).

Cordialement,

André

P.S. tulipe4 : Je m'excuse, mais je n'ai pas encore regardé ta proposition.

Bonjour à tous,

Je vous remercie pour tous vos retours et du temps que vous passez à bosser sur ces macros ou formules. C'est super de trouver un forum avec des membres aussi dévoués!!!

Je pense que la proposition de "ThauThème " me convient la mieux et je pense partir dessus ^^

Encore merci de vos retour et bonne journée à vous.