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 !