Copier 400 ligne 48fois chacune
Résolu
Camillegbg
Messages postés
38
Statut
Membre
-
Camillegbg Messages postés 38 Statut Membre -
Camillegbg Messages postés 38 Statut Membre -
Bonjour,
J ai un fichier avec les lignes rangées par dates et j aimerai faire se multiplier chaque ligne en 48, ce qui en fait me permet de découper chaque ligne (une journée) en demi-heure.
L'idée c est de partir du bas, si la macro ne rencontre que des lignes vides, il ne se passe rien mais si il y a un ligne avec des valeurs (dates ou autres) alors elle est dupliquée 48 fois..
je ne suis pas bien douée en VB mais j'ai un début de code:
Dim Supp As Boolean
Supp = False
Dim I As Long
Dim Plage As Range
Set Plage = Range("A4:B" & Range("B4").End(xlDown).Row)
For I = 400 To 1 Step -1
Supp = False
If (Plage.Cells(I).Value = 0) Then 'OU BIEN FAUT IL UTILISER ISEMPTY ?
Supp = False
Else
Supp = True
End If
If Supp = True Then
Plage.Cells(I).EntireRow.Select
'C'EST ICI QUE JE CHERCHE LE CODE VBA POUR FAIRE COPIER LA LIGNE ENTIERE 48 FOIS
' EN UTILISANT INSERT, GENRE: Row.Insert(x48Shiftdown)
End If
Next
Merci d'avance pour votre aide!
J ai un fichier avec les lignes rangées par dates et j aimerai faire se multiplier chaque ligne en 48, ce qui en fait me permet de découper chaque ligne (une journée) en demi-heure.
L'idée c est de partir du bas, si la macro ne rencontre que des lignes vides, il ne se passe rien mais si il y a un ligne avec des valeurs (dates ou autres) alors elle est dupliquée 48 fois..
je ne suis pas bien douée en VB mais j'ai un début de code:
Dim Supp As Boolean
Supp = False
Dim I As Long
Dim Plage As Range
Set Plage = Range("A4:B" & Range("B4").End(xlDown).Row)
For I = 400 To 1 Step -1
Supp = False
If (Plage.Cells(I).Value = 0) Then 'OU BIEN FAUT IL UTILISER ISEMPTY ?
Supp = False
Else
Supp = True
End If
If Supp = True Then
Plage.Cells(I).EntireRow.Select
'C'EST ICI QUE JE CHERCHE LE CODE VBA POUR FAIRE COPIER LA LIGNE ENTIERE 48 FOIS
' EN UTILISANT INSERT, GENRE: Row.Insert(x48Shiftdown)
End If
Next
Merci d'avance pour votre aide!
Configuration: Windows XP Internet Explorer 6.0
2 réponses
-
bonjour
pas sur d'avoir tout compris, mais essaye caRange("A" & i +1 & ":H" & i+47).entirerow.insert ' Insertion de 48 lignes en dessous de la ligne I
pour copier la ligne i 48 fois ajouter : Copie de la colonne A à la colonne Hrange("A" & i & ":H" & i+47).filldown -
Salut , Merci Wilfried ! :) j ai copié tes formules , et ça marche trop bien ! bravo l'expert ! :)
j ai mes 48lignes par jours , sur toutes une années , que j ai répété 5 onglets
