Copier et insérer des lignes à la suite avec VBA

Bonjour

J'ai un tableau avec des données heures/journées au format "dd/mm/yyy hh:mm", chaque ligne correspondant à 10 min;

J'essaye d'insérer des lignes en fonction de la durée définie et divisée par tranches de 10 min (par exemple, si j'ai une durée de 50 min je veux insérer 5 lignes), tout en copiant des données dedans, puis de passer à la ligne suivante et de recommencer le processus jusqu'à arriver à la fin de mon tableau.

J'ai pour l'instant réussi à insérer le b-nombre correct de lignes, mais mon code ne gère pas le passage au jour +1 ;

Par exemple, si un évènement démarre au 11/04/2023 23:10 et qu'il dure 90 min, il faut insérer 9 lignes, et gérer le passage au 12/04/2023 00:00 pour finir au 12/04/2023 00:40. Jusque là, j'arrive à insérer les 9 lignes, mais le jour n'est pas incrémenté au 12/04/2023, et reste au 11/04/2023.

Ci joint le code actuel :

Sub copier_2()

Dim index_2 As Integer
Dim total As Integer

Dim last2 As Integer

total = Cells(Rows.Count, 1).End(xlUp).Row
last2 = Cells(2, 9)
'total = Cells(2, 9)

Dim nb_lignes2 As Integer

index_2 = Cells(2, 9) + 3
For index_2 = last2 + total To last2 + 3 Step -1

'Sélection de la cellule N2
ActiveSheet.Cells(index_2, 14).Select

'sélection du nombre de ligne à insérer
nb_lignes2 = Cells(index_2, 8)
'MsgBox ("valeur" & nb_lignes2)

If nb_lignes2 > 0 Then
Cells(index_2 + 1, 8).Resize(nb_lignes2).EntireRow.Insert

'Copie de heure + date initial
Cells(index_2, 14).FormulaR1C1 = "=TEXT(RC[-13],""dd/mm/yyyy"")&"" ""& TEXT(RC[-10],""hh:mm"")"

'Insertion des pas horaires suivants

Cells(index_2 + 1, 14).Resize(nb_lignes2).FormulaR1C1 = _
"=TEXT(R[-1]C,""dd/mm/yyyy"")&"" ""& TEXT(R[-1]C+10/1440,""hh:mm"")"

End If

Next

End Sub

Edit modo : code à mettre entre balises avec le bouton </> merci d'y faire attention la prochaine fois

J'ai essayé de passer par des formules directement (avec des ET ou SI) mais sans succès...

Merci d'avance de votre aide :) !

Bonjour,

Avec une fonction

Function DateHeureMinute(ByVal DateDepart As Date, ByVal NbIterations As Integer) As Date

Dim I As Integer

    For I = 1 To NbIterations
        DateHeureMinute = DateDepart + NbIterations * 6.94444444444444E-03
    Next I

End Function

Bonjour Eric,

Merci pour votre réponse, j'ai tenté d'intégrer votre fonction à mon code mais sans succès..

Lors de votre essai, arriviez vous à insérer le nombre de lignes correspondant au nombre d'itérations?

Merci

Alix

Voir la feuille 2

Sub CreerLesLignes()

Dim TabHeures As ListObject
Dim LigneHeure As ListRow
Dim MaDate As Date
Dim I As Integer, NbLignes As Integer

     MaDate = CDate(Range("HeureDebut"))
     NbLignes = Range("NbIterations")

     Set TabHeures = Sheets("Feuil2").ListObjects("t_Heures")
     With TabHeures

          Set LigneHeure = .ListRows.Add
          LigneHeure.Range(1, 1) = MaDate
          Set LigneHeure = Nothing

          For I = 1 To NbLignes
              Set LigneHeure = .ListRows.Add
              LigneHeure.Range(1, 1) = DateHeureMinute(MaDate, I)
              Set LigneHeure = Nothing
          Next I
     End With

     Set TabHeures = Nothing

End Sub