XL 2010 Solution VBA pour créer/copie des lignes en fonction du nombre de jours entre deux dates

[Mateusz54]

Bonjour à tous,

Je bloque sur un problème.
Il me semblais que je vais pouvoir le régler par VBA, mais malheureusement j'arrive pas
J'ai besoin de copier des lignes d'une feuille sur une autre mais en les pressentant différemment. Je m'explique :
Sur le premier onglet j'ai des informations suivantes : N°, NOM, DATE_DEB, DATE_FIN, NB JRS (difference entre 2 dates). Par Exemple, sur les colonnes A, B, C, D et E :

A ; B ; C ; D ;E
001; XXXXX; 21/09/2020; 23/09/2020; 3
001; XXXXX; 28/09/2020; 01/10/2020; 4
002; YYYYY; 21/09/2020; 22/09/2020; 2
etc.

Je voudrais transcrire ces informations sur mon deuxième onglet mais avoir un résultat "jour par jour", donc pour chaque personne autant de lignes que jours entre date déb et date fin :
A ; B ; C ; D ;E
001; XXXXX; 21/09/2020; 21/09/2020; 1
001; XXXXX; 22/09/2020; 22/09/2020; 1
001; XXXXX; 23/09/2020; 23/09/2020; 1
001; XXXXX; 28/09/2020; 28/09/2020; 1
001; XXXXX; 29/09/2020; 29/09/2020; 1
001; XXXXX; 30/09/2020; 30/09/2020; 1
001; XXXXX; 01/10/2020; 10/10/2020; 1
002; YYYYY; 21/09/2020; 21/09/2020; 1
002; YYYYY; 22/09/2020; 22/09/2020; 1

Mon problème c'est que je suis pas assez fort pour faire des boucles... Si quelqu'un a une solution ou une piste au moins,
je vous serai reconnaissant

 

[sylvanu]

Bonjour Mateusz,
En PJ un essai avec :

Sub Transfert()
Sheets("Feuil2").Range("A:A").ClearContents     ' Efface matrice de sortie
DerLig = Range("A65500").End(xlUp).Row          ' Récupère nombre ligne matrice d'entrée
Lw = 1                                          ' Indice d'écriture
For L = 1 To DerLig                             ' Pour toutes les lignes
    tablo = Split(Range("A" & L), ";")          ' Met la chaine dans un tablo splitté avec séparateur ";"
    DateVal = CDate(tablo(2))                   ' Met en nombre la chaine Date
    For N = 1 To tablo(4)                       ' De 1 jusqu'au nombre demandé dans la chaine
        ' Reconstruit la chaine de sortie ( DateVal+N+1 donne la date demandée )
        Sheets("Feuil2").Cells(Lw, 1) = tablo(0) & ";" & tablo(1) & ";" & DateVal + N - 1 & ";" & DateVal + N - 1 & ";" & "1"
        Lw = Lw + 1                             ' Incrément ligne de sortie
    Next N
Next L
End Sub

Si j'ai bien tout compris.

 

[Mateusz54]

Merci!
ça a l'air bien et ça fonctionne sauf que je me suis mal exprimé....
Chaque donnée est dans une colonne séparée (c'est un tableau au faite).
Donc A (N°); B(NOM); C(date_deb); D (Date fin) et en E (NB JRS). Et en sortie je voudrais également obtenir un tableau sur 5 colonnes.

 

[sylvanu]

sauf que je me suis mal exprimé

Entièrement d'accord.
Car en fait c'est beaucoup plus simple avec :

Sub Transfert()
Sheets("Feuil2").Range("A:E").ClearContents     ' Efface matrice de sortie
DerLig = Range("A65500").End(xlUp).Row          ' Récupère nombre ligne matrice d'entrée
Lw = 1                                          ' Indice d'écriture
For L = 1 To DerLig                             ' Pour toutes les lignes
    DateVal = CDate(Cells(L, 3))                ' Récupération date initiale
    For N = 1 To Cells(L, 5)                    ' De 1 jusqu'au nombre demandé dans la chaine
        Sheets("Feuil2").Cells(Lw, 1) = Cells(L, 1)
        Sheets("Feuil2").Cells(Lw, 2) = Cells(L, 2)
        Sheets("Feuil2").Cells(Lw, 3) = DateVal + N - 1
        Sheets("Feuil2").Cells(Lw, 4) = DateVal + N - 1
        Sheets("Feuil2").Cells(Lw, 5) = 1
        Lw = Lw + 1                             ' Incrément ligne de sortie
    Next N
Next L
End Sub

 

[Mateusz54]

Merci beaucoup, c'est tout à fait ce que j'ai recherché
J'ai pas tout compris, surtout l'histoire de "Lw", mais ça marche nickel!

 

[sylvanu]

Lw est tout simplement la ligne où on va écrire.
Dès qu'une ligne est remplie, on incrémente Lw pour passer à la ligne suivante.
( Tout simplement Lw pour Line Written )