Copier et Insérer des lignes à la suite dans VBA

Bonjour

J'ai un tableau avec des données heures/journées, et des durées pour chaque ligne.

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'arrive à copier la première ligne en insérant le bon nombre de lignes, mais en faisant une boucle "if", les premières lignes copiées sont remplacées par les suivantes etc...

Est ce que vous auriez un moyen pour insérer les lignes sans supprimer les existantes (pour les copier à la suite)?

Ci dessous mon code :

Sub Copier_Cellules()
'
' Copier_Cellules Macro
'
Dim index As Integer
Dim last As Integer
last = Cells(Rows.Count, 1).End(xlUp).Row
Dim nb_lignes As Integer

For index = 2 To last

ActiveSheet.Cells(index, 14).Select

nb_lignes = Cells(index, 10)

ActiveCell.FormulaR1C1 = _
"=TEXT(RC[-13],""dd/mm/yyyy"")&"" ""& TEXT(RC[-10],""hh:mm"")"
ActiveSheet.Cells(index, 14).Select
ActiveSheet.Cells(index + 1, 14).Select

ActiveCell.FormulaR1C1 = _
"=TEXT(R[-1]C,""dd/mm/yyyy"")&"" ""& TEXT(R[-1]C+10/1440,""hh:mm"")"
Selection.AutoFill Destination:=Range(Cells(index + 1, 14), Cells(nb_lignes, 14)), Type:=xlFillDefault

'Next
End Sub

Merci d'avance :) !

Hello,

Premier passage de boucle :

index vaut 2 ;

ActiveSheet.Cells(index, 14).Select => ligne 2 colonne 14 ; =TEXT(RC[-13],""dd/m .... => insertion formule en ligne 2 col 14

ActiveSheet.Cells(index + 1, 14).Select => ligne 3 colonne 14 ; "=TEXT(R[-1]C,""d ...... insertion formule en ligne 3 col 14

2eme passage de boucle

index vaut 3 :

ActiveSheet.Cells(index, 14).Select => ligne 3 colonne 14 ; =TEXT(RC[-13],""dd/m .... => insertion formule en ligne 3 col 14 donc écrase ce que tu as fait au dessus

Il faut revoir ta méthodo, elle n'est pas bonne

faute classique, avec des problèmes pareilles, le boucle est de la fin jusqu'au début, donc For index = last to 2 step -1

mais je vois nul part où vous insérer x nouveau lignes ?

je ne suis pas sur des formules, problème linguistique !

Sub Copier_Cellules()
     '
     ' Copier_Cellules Macro
     '
     Dim index As Integer
     Dim last  As Integer
     last = Cells(Rows.Count, 1).End(xlUp).Row
     Dim nb_lignes As Integer

     For index = last To 2 Step -1
          nb_lignes = WorksheetFunction.Ceiling_Math(index / 10, 1)     'durée / 10 + aroundier en haut = nombre de lignes
          If nb_lignes > 0 Then
               Cells(index + 1, 10).Resize(nb_lignes).EntireRow.Insert     'ajouter des lignes
               Cells(index, 14).FormulaR1C1 = "=TEXT(RC[-13],""dd/mm/yyyy"")&"" ""& TEXT(RC[-10],""hh:mm"")"     'formule 1
               Cells(index + 1, 14).Resize(nb_lignes).FormulaR1C1 = "=TEXT(R[-1]C,""dd/mm/yyyy"")&"" ""& TEXT(R[-1]C+10/1440,""hh:mm"")"
          End If
     Next
End Sub

Merci à vous, j'ai réessayé et ça fonctionne !