Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Aide/macro pour réorganisation de feuille

4 réponses
Avatar
Julien
Bonjour à tous,

Si une ame charitable pouvait m'aider à créer une macro qui rorganiserait ma
feuille qui comporte plusieurs milliers de lignes de la façon suivante
(de l'exemple de gauche à celui de droite):
http://cjoint.com/?gAclk0YjAR

Merci beaucoup par avance
Julien

4 réponses

Avatar
isabelle
bonjour Julien,

Sub Macro1()
For i = 1 To Sheets("Feuil1").Range("A65536").End(xlUp).Row Step 3
Sheets("Feuil1").Range(Cells(i, 1), Cells(i + 2, 1)).Copy
Sheets("Feuil2").Cells(i, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
Next
End Sub

isabelle

Bonjour à tous,

Si une ame charitable pouvait m'aider à créer une macro qui
rorganiserait ma feuille qui comporte plusieurs milliers de lignes de la
façon suivante
(de l'exemple de gauche à celui de droite):
http://cjoint.com/?gAclk0YjAR

Merci beaucoup par avance
Julien



Avatar
tissot.emmanuel
Bonsoir,

Sub Transposition()
Dim i As Long, j As Integer, z(0 To 2)
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
With Range(Range("A1"), Range("A65536").End(xlUp))
For i = 1 To .Rows.Count Step 3
For j = 0 To 2
z(j) = .Cells(i + j)
Next
.Cells(i).Resize(1, 3).Value = z
Next
End With
Range("B:B").SpecialCells(xlCellTypeBlanks).Offset(0, -1).ClearContents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

A tester.

Cordialement,

Manu/

"Julien" a écrit dans le message de news:
46805a97$0$20739$
Bonjour à tous,

Si une ame charitable pouvait m'aider à créer une macro qui rorganiserait
ma feuille qui comporte plusieurs milliers de lignes de la façon suivante
(de l'exemple de gauche à celui de droite):
http://cjoint.com/?gAclk0YjAR

Merci beaucoup par avance
Julien



Avatar
LSteph
Bonjour,
(de l'exemple....donc une seule colonne. Peut durer quelques secondes.


Sub AsurtroisCol()
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To [a65536].End(xlUp).Row
[b:d].Cells(i) = [a:a].Cells(i)
Next
Columns(1).Delete
End Sub


Bonjour à tous,

Si une ame charitable pouvait m'aider à créer une macro qui
rorganiserait ma feuille qui comporte plusieurs milliers de lignes de la
façon suivante
(de l'exemple de gauche à celui de droite):
http://cjoint.com/?gAclk0YjAR

Merci beaucoup par avance
Julien



Avatar
Julien
Bonjour,
Incroyable de rapidité et de précisions! Merci à tous vous m'avez enlevé une
sacrée épine du pied! ;))
Bonne journée et encore merci. ;)
Julien