Module VBA Dupliquer ligne et incrémenter date

Bonjour à tous,

J'ai plusieurs tableaux, dont un exemple ci joint.

J'ai besoin de dupliquer chaque ligne, selon le nombre de jours se trouvant en D (en réalité l'intervalle entre B et C).

Et pour chaque ligne insérée, j'ai besoin que la date en B s'incrémente de 1 jour à chaque fois, jusqu'à la date de fin.

J'ai trouvé ce code sur un forum, qui fonctionne pour la duplication, mais je ne sais pas comment et où intégrer la fonction d'incrémentation de la date et à ce jour j'incrémente tout manuellement, ce qui est très long.

Sub CopyData()
Dim xRow As Long
Dim VInSertNum As Variant
xRow = 1
Application.ScreenUpdating = False
Do While (Cells(xRow, "A") <> "")
VInSertNum = Cells(xRow, "D")
If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
Range(Cells(xRow, "A"), Cells(xRow, "D")).Copy
Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "D")).Select
Selection.Insert Shift:=xlDown
xRow = xRow + VInSertNum - 1
End If
xRow = xRow + 1
Loop
Application.ScreenUpdating = False
End Sub

Pouvez vous m'aider ?

En vous remerciant par avance.

Bien cordialement.

Bonjour et bienvenue

Merci de bien vouloir utiliser les balises de code mises à votre disposition en cliquant sur l'icone </> dans la barre de menu et en collant vos codes dans la fenêtre

Vu que c'est votre premier post, je l'ai corrigé.

Pensez aussi à faire une petite présentation ICI

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 du nouveau forum

Regardez aussi les petites icônes mises à votre disposition dans la barre de menu

Merci de votre participation

Bonjour

Merci pour la correction, je n'ai pas pensé aux balises.

Pour la présentation et la charte, c'est fait

Merci et bonne journée.

Re

Dans votre vrai fichier la colonne D (nb jour) existe toujours ?

ReBonjour Dan,

Dans cet exemple il s'agit de la colonne D; mais cela peut changer selon les feuilles, donc je modifie le module en fonction, si je ne peux pas adapter la feuille au module.

En fait la colonne D me sert à calculer le nombre de jour (lignes) à dupliquer pour chaque identifiant. Elle sera supprimée dans le résultat final où je n'ai plus besoin que de l'identifiant et de la date d'exécution incrémentée. La dernière colonne deviendra une colonne de prix à appliquer pour chaque ligne.

J'espère être assez claire.

Merci.

Ma question était que l'on pourrait se passer de la colonne D.

Mais puisque la colonne D est supprimée ensuite on peut aussi prévoir le cas en calculant la colonne D dans le code.
Voyez déjà si ceci fait ce que vous voulez.

Sub CopyData()
Dim dlg As Integer, lg As Integer, nb As Integer, i As Integer
Dim nbjour As Integer, j As Integer

With ActiveSheet
    dlg = .Range("A" & Rows.Count).End(xlUp).Row
    lg = dlg + 1
    nb = dlg

    For i = 2 To nb
        nbjour = .Range("D" & i).Value - 1
        While j < nbjour
            .Range("A" & i & ":C" & i).copy Range("A" & lg)
            .Range("B" & lg) = CDate(CLng(Range("B" & lg)) + 1) + j
            j = j + 1
            lg = lg + 1
            nb = nb + 1
        Wend
        j = 0
    Next i

    'tri des données
    dlg = .Range("A" & Rows.Count).End(xlUp).Row
    With .Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=Range("A2:A1" & dlg), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add2 Key:=Range("B2:B" & dlg), SortOn:=xlSortOnValues, Order:=xlAscending
        .SetRange Range("A1:D" & dlg)
        .Header = xlYes
        '.MatchCase = False
        .Orientation = xlTopToBottom
        '.SortMethod = xlPinYin
        .Apply
    End With
End With
End Sub

Merci Dan, Cela à l'air de fonctionner sur un nombre réduit de lignes, sinon ca plante (ou alors je n'ai pas attendu assez longtemps, ma feuille contient près de 6700 lignes)

En recommençant sur le fichier de test, j'ai le résultat attendu mais j'ai ces messages d'erreur:

Dois je modifier quelque chose ?

Merci

Essayez en enlevant le 2 à coté des 2 ADD

Effectivement en enlevant les 2 après les Add, la macro va jusqu'au bout et finit par un tri, ce qui n'était pas le cas avec l'autre.

Merci beaucoup, vous m'enlevez une épine du pied !

On est d'accord que cela ne fonctionne que si D existe est contient le nombre de jour ? auquel cas, je prévois de la créer.

Pour finir, si je ne souhaite pas incrémenter de 1 jour mais de 7 jours (1 ligne par semaine), quelle donnée dois-je modifier dans les lignes de code ?

Merci à vous.

On est d'accord que cela ne fonctionne que si D existe est contient le nombre de jour ? auquel cas, je prévois de la créer.

Si vous voulez vous passer de la colonne D, remplacez cette ligne

nbjour = .Range("D" & i).Value - 1

par celle-ci

nbjour = CLng(.Range("C" & i).Value) - CLng(.Range("B" & i).Value)

Pour finir, si je ne souhaite pas incrémenter de 1 jour mais de 7 jours (1 ligne par semaine), quelle donnée dois-je modifier dans les lignes de code ?

1. Juste au dessus de la ligne For i = 2 to nb, ajoutez ceci

j = 7

2. Juste avant lg = lg + 1 remplacez j = j + 1 par

j = j + 7

3. Juste après le WEND, remplacez j = 0 par

J = 7

Si ok et terminé, -->

Cordialement

Bonjour

Tout est clair !

Merci beaucoup.

Passez une bonne journée.

bien cordialement.