Répeter une macro pour chacune de mes lignes

Question

Bonjour, 

Alors je suis débute en excel et le VBA est pour moi l'inconnu ! 
je vous explique mon problème je dois creéer un nouveau tableau regroupant mes données. J'ai réussi a créer une macro pour la première ligne cepedant je ne sais pas comment faire pour l'appliquer à toutes les lignes, sachant que dans le dossier finial il y a environ 2000 lignes. 

Les lignes auqel il faudrait l'appliquer vas de I12 à I2000

Voici le code :

Sub Macro1()
'
' Macro1 Macro
'    
    Range("K12:M12").Select
    Selection.Copy
    Range("F15:F17").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("E15:E17").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("I12").Select
    Selection.Copy
    Range("E15:E17").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
      
   End With
 End Sub


exemple de ce que je souhaite : 

 
Pourriez vous m'expliquer comment faire  svp, je souhaite comprendre afin de pouvoir m'initier au VBA 

Par avance, merci 


EDIT : Ajout des balises de code.
Merci de bien vouloir utiliser la coloration syntaxique (les balises de code) lorsque tu postes du code sur le forum.
Explications disponibles ici :
https://codes-sources.commentcamarche.net/faq/10686-le-nouveau-codes-sources-comment-ca-marche#balises-code

Configuration: Windows 7 / Internet Explorer 9.0

ThauTheme · Answer

Bonsoir Marion, bonsoir le forum,

Peut-être comme ça :

Sub Macro1()
Dim I As Integer
For I = 12 To 2000
    Range(Cells(I, 11), Cells(I, 13)).Copy
    Range(Cells(I + 3, 6), Cells(I + 5, 6)).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    Application.CutCopyMode = False
    Range(Cells(I + 3, 5), Cells(I + 5, 5)).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Cells(I, 9).Copy Range(Cells(I + 3, 5), Cells(I + 5, 5))
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
Next I
End Sub

ThauTheme · Answer

Bonjour Marion, bonjour le forum,

En effet c'est plus clair mais un petit fichier exemple aurait été encore mieux...

Je te propose de  passer par un second onglet pour renvoyer le trableau transposé :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TL As Variant 'déclare la variable TL (Tableau de Ligne)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OS = Sheets("Feuil1") 'définit l'onglet OS (à adapter)
DL = OS.Cells(Application.Rows.Count, 9).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 9 (=I) de l'onglet OS
Set OD = Sheets("Feuil2") 'définit l'onglet OD (à adapter)
OD.Range("A1").Value = "Repère" 'écrit "Repère" en A1 de l'onglet OD
OD.Range("B1").Value = "Fils" 'écrit "Fils" en B1 de l'onglet OD
For I = 12 To DL 'boucle sur toutes les lignes I de 12 à DL
    'définit le tableau de ligne TL (les Fils à partir de la colonne 10 (=J))
    TL = OS.Range(OS.Cells(I, 10), OS.Cells(I, Application.Columns.Count).End(xlToLeft))
    'définit la cellule de destination DEST
    Set DEST = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    'revoie dans DEST redimentsionnée et décalée d'une colonne à droite le tableau TL transposé
    'si le tableau ne contient qu'un seul élément cela génère une erreur
    DEST.Offset(0, 1).Resize(UBound(TL, 2), 1).Value = Application.Transpose(TL)
    If Err <> 0 Then 'condition : si une erreur a été générée
        'renvoie dans dest décalée d'une colonne à droite la valeur de la cellule ligne I colonne 10 (=J)
        DEST.Offset(0, 1).Value = OS.Cells(I, 10).Value
        GoTo suite 'va à l'étiquette "suite"
    End If 'fin de la condition
    DEST.Resize(UBound(TL, 2), 1).Merge 'fusionne la cellue DEST
suite: 'étiquette
    On Error GoTo 0 'annule la gestion des erreurs
    DEST.Value = OS.Cells(I, 9) 'renvoie dans dest la valeur de la cellule ligne I colonne 9 (=I)
Next I 'prochaine ligne de la boucle
End Sub
 
 
À plus,
ThauTheme

Répeter une macro pour chacune de mes lignes

2 réponses

Discussions similaires

Newsletters