Restructurer des données

[nephtys38]

Bonjour, j'ai commencé à écrire une macro pour restructurer des données dans la colonne A. Je sélectionne les données de A1 à A12 que je transpose en B1.
Puis il faut que je refasse la même chose à la cellule A13, A25 ect, toutes les 12 lignes.
J'ai commencé à écrire une partie de la macro mais je ne m'y connait pas du tout en VB donc pour la partie boucle je ne sait pas trop comment procéder...
Merci.

Sub sfp()
Dim cell As Range
cell = Range("A1")
Do While IsEmpty(cell.Value) = False
Range("A1:A12").Select
Selection.Copy
ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
Loop

End Sub

 

[wilfried_42]

Re : Restructurer des données

Bonjour
j'ai écrit cette macro à main levée et n'ai pu la tester :

Sub sfp()
Dim i as long
      For i = 1 to range("A65536").end(xlup).row step 12 ' I va de 1 à la fin de la colonne en sautant 12 lignes
           Range("A" & i & ":A" & i+11).copy ' Copie des 12 cellules
           Range("B" & ((i-1)\12)+1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True ' ((i-1)/12) + 1 donne ligne 1,2,3,4,5,6. si cela doit etre copié sir les ligne 1,13,15.... ne mettre que i
      next i
End Sub

 

[ROGER2327]

Re : Restructurer des données

Bonjour à tous

Un autre proposition à tester :

Sub sfp()
Dim d&, cell As Range
  Set cell = Range("A1")
  Do Until IsEmpty(cell.Offset(12 * d, 0))
    cell.Offset(12 * d, 0).Resize(12, 1).Copy
    cell.Offset(12 * d, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= False, Transpose:=True
    d = d + 1
  Loop
  Application.CutCopyMode = False
  cell.Activate
End Sub

ou peut-être (mais ce n'est plus "refaire la même chose toutes les douze lignes) :

Sub sfp()
Dim d&, cell As Range
  Set cell = Range("A1")
  Do Until IsEmpty(cell.Offset(12 * d, 0))
    cell.Offset(12 * d, 0).Resize(12, 1).Copy
    cell.Offset(d, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= False, Transpose:=True
    d = d + 1
  Loop
  Application.CutCopyMode = False
  cell.Activate
End Sub

​

ROGER2327
#5026

Mardi 10 Pédale 138 (Nativité de Saint Tancrède, jeune homme, SQ)
14 Ventôse An CCXIX
2011-W09-5T10:46:24Z

 

[nephtys38]

Re : Restructurer des données

Merci pour vos réponses, j'ai pu m'en aider pour ajuster ma macro qui fonctionne maintenant!