ajout de ligne

Bonjour.
Essaie la macro suivante :

Sub test()
Dim sh As Worksheet, c As Range, Ligne As Long
Application.ScreenUpdating = False
Set sh = ActiveSheet
Sheets.Add.Name = "temp"
Ligne = 1
For Each c In Range(sh.[A1], sh.[A65536].End(xlUp))
Range(c, c.Offset(, 3)).Copy
Cells(Ligne, 1).PasteSpecial xlPasteAll
Cells(Ligne + 1, 4) = "Structure"
Ligne = Ligne + 4
Next c
sh.Cells.Clear
ActiveSheet.UsedRange.Copy
sh.Paste
Application.DisplayAlerts = False
Sheets("temp").Delete
Application.DisplayAlerts = False
End Sub

Daniel

Bonjour j'ai insérer trois ligne entre chaque iten je pense que ca cas etre
long car j'ai plus de 1000 item pouvez-vous m'aider pour que je passe moinn
de temps voici mon tableau Merci

http://cjoint.com/?gqmhxqRDT0

Petite correction :

Sub test()
Dim sh As Worksheet, c As Range, Ligne As Long
Application.ScreenUpdating = False
Set sh = ActiveSheet
Sheets.Add.Name = "temp"
Ligne = 1
For Each c In Range(sh.[A1], sh.[A65536].End(xlUp))
Range(c, c.Offset(, 3)).Copy
Cells(Ligne, 1).PasteSpecial xlPasteAll
Cells(Ligne + 1, 4) = "Structure"
Ligne = Ligne + 4
Next c
sh.Cells.Clear
ActiveSheet.UsedRange.Copy
sh.Paste
Application.DisplayAlerts = False
Sheets("temp").Delete
Rows("1:4").Delete
Application.DisplayAlerts = False
End Sub

Daniel

Bonjour.
Essaie la macro suivante :

Sub test()
Dim sh As Worksheet, c As Range, Ligne As Long
Application.ScreenUpdating = False
Set sh = ActiveSheet
Sheets.Add.Name = "temp"
Ligne = 1
For Each c In Range(sh.[A1], sh.[A65536].End(xlUp))
Range(c, c.Offset(, 3)).Copy
Cells(Ligne, 1).PasteSpecial xlPasteAll
Cells(Ligne + 1, 4) = "Structure"
Ligne = Ligne + 4
Next c
sh.Cells.Clear
ActiveSheet.UsedRange.Copy
sh.Paste
Application.DisplayAlerts = False
Sheets("temp").Delete
Application.DisplayAlerts = False
End Sub

Daniel

Bonjour j'ai insérer trois ligne entre chaque iten je pense que ca cas
etre long car j'ai plus de 1000 item pouvez-vous m'aider pour que je passe
moinn de temps voici mon tableau Merci

http://cjoint.com/?gqmhxqRDT0

Bonjour j-marc,

si tu t'y connais en copier / coller, voici une solution :
tu numérotes de 1 à 1000 les lignes existantes puis tu copies la
numérotation et tu la colles 3x à la suite, dans la colonne de
numérotation. Le plus dur reste à faire : trier sur les chiffres. Tu
obtiens 4x chaque nombre et enface du premier nombre de chaque valeur,
tes données. Ensuite tu peux supprimer cette colonne, mais elle
pourrait encore servir…

Jac

j-marc vient de nous annoncer :

Bonjour j'ai insérer trois ligne entre chaque iten je pense que ca cas etre
long car j'ai plus de 1000 item pouvez-vous m'aider pour que je passe moinn
de temps voici mon tableau Merci

http://cjoint.com/?gqmhxqRDT0

Bonjour,
Suivre l'execution un peu longue ( 30 secondes) dans la barre d'état

Sub inser3()
Dim i As Long, start As Long
Application.ScreenUpdating = False
start = [a65536].End(xlUp).Row
For i = start To 2 Step -1
With Rows(i)
Range(.Cells(1), .Offset(2)).EntireRow.Insert xlShiftDown
Cells(i, 4) = "Structure"
If i Mod 10 = 0 Then
Application.StatusBar = "Execution de " & start - i & " / " & start
End If
End With
Next
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

'lSteph

On 16 juin, 12:15, j-marc <jm...@discussions.microsoft.com> wrote:

Bonjour  j'ai insérer trois ligne entre chaque iten je pense que ca c as etre
long car j'ai plus de 1000 item pouvez-vous m'aider pour que je passe moi nn
de temps voici mon tableau    Merci

http://cjoint.com/?gqmhxqRDT0