XL 2010 Séparer une ligne en plusieurs lignes

[julien6337]

Bonjour,


J'ai un fichier excel avec plusieurs lignes. Dans la colonne C, j'ai un point kilométrique de début et dans la colonne D un point kilométrique de fin concernant les infos de la ligne. Ces 2 points définissent donc une zone enveloppe.
Or je souhaiterais pouvoir découper en plusieurs lignes en conservant les données de toutes la ligne mais en séparant en autant de ligne qu'il y a d'hectomètre dans la zone enveloppe (par exemple si la ligne 1 concerne une zone enveloppe du km 2 au km 3,2, je voudrais que les données soient collées sur 13 lignes en ajoutant dans une nouvelle colonne le point concerné donc 2; 2,1; 2,2; .....3,2 et en conservant toutes les autres données). Il faudrait également que si l'enveloppe s’arrête par exemple 2,05 par exemple, le premier point soit au 2.

IL faudrait que cette conversion se fasse dans un autre onglet

Je vous joint un fichier type

Merci d'avance

 

[sousou]

Bonjour
essaie cette macro coupe()

 

[julien6337]

Bonjour
Merci pour le retour, je viens de lancer la macro mais pour le moment ça me renvoi uniquement une ligne dans la feuille 2,
je vais essayer de regarder aussi de mon côté comment faire évoluer ton code.


Sub coupe()
With Sheets(2)
Set Z = .Range(.Cells(2, 1), .Cells(.UsedRange.Rows.Count, 1)).EntireRow
Z.Delete
End With
With Sheets(1)
flg = .Cells(.UsedRange.Rows.Count + 1, 2).End(xlUp).Row
For n = 2 To flg
If .Cells(n, 3) <> "" Then
Call cop(.Cells(n, 3))
End If


Next
End With
End Sub

Sub cop(cel)
kmd = Int(cel * 10): kmf = Int(cel.Offset(0, 1) * 10)

With Sheets(2)

For n = kmd To kmf
flg = .Cells(.UsedRange.Rows.Count + 1, 2).End(xlUp).Row
cel.EntireRow.Copy .Rows(flg + 1)
.Cells(flg + 1, 1) = n / 10
Next
End With
End Sub

 

[julien6337]

En fait toutes les lignes apparaissent une à une mais sont remplacées au fur et à mesure par la suivante, il ne reste donc au final plus que la dernière ligne, je ne parviens pas à corriger.

 

[sousou]

désolé, change ces deux ligne en ajoutant le +1
Set Z = .Range(.Cells(2, 1), .Cells(.UsedRange.Rows.Count + 1, 1)).EntireRow
Z.Delete

 

[julien6337]

Bonjour,

ça fonctionne parfaitement, merci beaucoup.
il va falloir que je me remette à VBA, ce sont de très lointain souvenirs pour moi mais j'aime beaucoup