Appliquer une suite de chiffre à une liste

Bonjour à tous,

Je souhaiterais appliquer une suite de chiffre à une liste comprenant 2 colonnes.

Par exemple, j'ai une suite de chiffre dans un tableau ... 1 - 2 - 3 - 4 - 5 , et j'aimerais une fonction ou macro permettant de facilement appliquer cette suite à une liste de Nom / Prénom

Pour que le résultat soit :

NOM / Prénom / 1

NOM / Prénom / 2

Nom / Prénom / 3

Nom / Prénom / 4

Nom / Prénom / 5

Je vous joint un fichier c'est mieux.

Merci par avance de votre retour :)

Cdt

Bonjour,

avec une petite macro
eric

Merci eriiiiiiiiiic

Superbe macro. Je l'ai adaptée à mon fichier et ça fonctionne parfaitement !

Résolu

Bonjour,

Je reviens vers cette macro (qui m'a beaucoup servie, merci beaucoup @eriiic !)

J'ai tenté 2 modifications :

- Arrêter la suppression intégrale du bloc précédent (pas réussi)

- Rajout de nouvelles lignes à dupliquer (réussi partiellement)

En fait le soucis c'est que, lorsque je n'ai qu'un seul bloc ("NOM Prénom") à dupliquer, ça ne fonctionne pas, il en faut 2 minimum.

Code proposé par Eriiic :

Option Explicit

Sub dupliq()
    Dim datas1, datas2, datas3(), nb As Long
    Dim lig1 As Long, lig3 As Long, I As Long, j As Long
    datas1 = [T_nom].Value: datas2 = [T_nb].Value
    ReDim datas3(1 To UBound(datas1) * UBound(datas2), 1 To 3)
    For lig1 = 1 To UBound(datas1)
        For I = 1 To UBound(datas2)
            lig3 = lig3 + 1
            datas3(lig3, 1) = datas2(((lig3 - 1) Mod UBound(datas2)) + 1, 1)
            datas3(lig3, 2) = datas1(lig1, 1)
            datas3(lig3, 3) = datas1(lig1, 2)
        Next I
    Next lig1
    With ActiveSheet.ListObjects("T_liste")
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    End With
    [T_liste].Resize(UBound(datas3)) = datas3
End Sub

Mes modifications :

Option Explicit

Sub dupliq()
    Dim datas1, datas2, datas3(), nb As Long
    Dim lig1 As Long, lig3 As Long, I As Long, j As Long
    datas1 = [Nom_Généré].Value: datas2 = [T_Semaine2].Value
    ReDim datas3(1 To UBound(datas1) * UBound(datas2), 1 To 6)
    For lig1 = 1 To UBound(datas1)
        For I = 1 To UBound(datas2)
            lig3 = lig3 + 1
            datas3(lig3, 1) = datas2(((lig3 - 1) Mod UBound(datas2)) + 1, 1) 'copier l'année
            datas3(lig3, 2) = datas2(((lig3 - 1) Mod UBound(datas2)) + 1, 2) 'copier le mois
            datas3(lig3, 3) = datas2(((lig3 - 1) Mod UBound(datas2)) + 1, 3) 'copier le numéro de semaine

            datas3(lig3, 5) = datas2(((lig3 - 1) Mod UBound(datas2)) + 1, 4) 'copier le début de semaine
            datas3(lig3, 6) = datas2(((lig3 - 1) Mod UBound(datas2)) + 1, 5) 'copier la fin de semaine

            datas3(lig3, 4) = datas1(lig1, 1) 'copier le nom / prénom

        Next I
    Next lig1
    With ActiveSheet.ListObjects("T_liste_2")
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    End With
    [T_liste_2].Resize(UBound(datas3)) = datas3
End Sub

Merci par avance de votre aide

Cordialement

Bonjour,

ton fichier n'a plus rien à voir avec les explications du début (plus de numéros, un NOM Test absent du tableau ?!?).
Merci de les reprendre en conséquence, de fournir un fichier produisant l'anomalie, les manips à faire et ce qui est attendu.
eric

Bonjour,

Alors dans ce cas j'ai repris le fichier transmis initialement, avec les adaptions en fonction de mes besoins.

En résumé :

tableau t_nom / passe de 2 => 1 colonne

tableau t_nb / passe de 1 => 5 colonnes

Par contre là, je suis un peu paumé.

Suite à ta demande, j'ai refait le code à l'exactitude pour reproduire le bug... Sauf qu'il ne se reproduit pas !

______________

Exemple : ce fichier fonctionne (avec 1 seul nom à reproduire)

_____________

Et celui là bug (code identique, tableaux identiques, mais disposition légèrement différente)

J'ai vérifié plusieurs fois, tout semble identique...

Y a t-il des paramètres supplémentaires ?

Cordialement

Tu n'as as répondu à mes interrogations et je n'ai pas trop envie de me prendre la tête à essayer de comprendre.
Je referme...
eric

Eric,

Tes interrogations sont sur la présentation ou il y a quelque chose que je ne vois pas ? Parce que, depuis le début, on parle toujours de la même chose (dupliquer/ générer une suite...)

J'ai transmis une version modifiée (pour mon usage) mais le code reste strictement le même que tu m'as transmis en mars dernier (j'ai juste rajouté des lignes et mis "1 to 6" sur la 5ème ligne de code au lieu de "1 to 3")

Que ce soit des chiffres, des dates, du texte, etc, le principe reste toujours le même.

Ma demande initiale était de :

1) Comprendre l'origine d'un bug (qui se produit sur le fichier

) mais pas sur le fichier appliquer-une-suite-a-une-liste-1-v2.xlsm , alors que le code est identique)

2) Je souhaiterais que le résultat s'empile (au lieu d'effacer le bloc)

Je vois difficilement comment être plus plus clair.

Par contre si tu estimes que ma demande dérive du sujet initial (pas forcément d'accord) ou que c'est tout simplement pas possible, alors pas de soucis.

Cordialement

Edit : Pour le point N°1, je viens de comprendre que le bug se produit uniquement si le tableau ne comporte qu'une seule colonne ! Dès que j'en ajoute une deuxième, plus de bug

Bonjour,

le fait que tu aies remplacé des nombres par du texte dans Nom_Généré m'a perturbé.
Comme c'est ancien, une lecture rapide m'a laissé pensé qu'un nombre avait son rôle.
C'est ce que je voulais dire dans "plus de numéros"

Remplace le début par :

Sub dupliq()
    Dim datas1, datas2, datas3(), nb As Long
    Dim lig1 As Long, lig3 As Long, I As Long, j As Long
    datas1 = [Nom_Généré].Value: datas2 = [T_Semaine2].Value
    If Not IsArray(datas1) Then
        ReDim datas1(1 To 1, 1 To 1): datas1(1, 1) = [Nom_Généré].Value
    End If
    ReDim datas3(1 To UBound(datas1) * UBound(datas2), 1 To 6)
    ...

en supposant que T_Semaine2 ait toujours plusieurs colonnes et sera toujours lu en tant que tableau.
Sinon il pourra faire la même erreur qu'il faudrait traiter à l'identique
eric

Bonjour,

Merci eric ça fonctionne avec 1 seule colonne à présent.

Cordialement