Macro : appliquer aux lignes suivantes

[Ptikafe]

Bonjour à tous,

Ceci est ma première contribution, alors je vais essayer d'être clair. J'ai effectué plusieurs séquences d'instructions via l'enregistrement d'une macro. (script ci-joint dessous).

Sur un tableau comportant plusieurs lignes de données, je cherche à insérer 2 nouvelles lignes vierges sous chaques lignes renseignées pour reporter leurs données et les concatener ensuite.

Ma macro fonctionne pour ma première ligne de données, située en Rows("2:2"), mais je ne sais pas comment appliquer cette macro aux lignes suivantes du tableau actif. Attention, ma macro consistant à insérer 2 lignes nouvelles sous chaque lignes renseignées un décalage se créer au fur et à mesure des opérations.

Merci de votre aide.

------------------------

Sub Macro4()
'
' Macro4 Macro
' Macro enregistrée le 08/08/2008
'

'
Rows("3:3").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Rows("2:2").Select
Selection.Copy
Rows("3:4").Select
ActiveSheet.Paste
Range("J3").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("J4").Select
Selection.ClearContents
Range("K4").Select
Selection.ClearContents
Range("O3").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-6],RC[-4])"
Range("O4").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-6],RC[-3])"
Range("O5").Select
End Sub

 

[Robert]

Re : Macro : appliquer aux lignes suivantes

Bonjour Ptikafe, bonjour le forum,

je te propose le code suivant :

Sub Macro2()
Dim dl As Integer 'déclare la variable dl
Dim x As Integer 'déclare la variable x
dl = Range("A65536").End(xlUp).Row 'définit la variable dl
For x = dl To 2 Step -1 'boucle inversée des lignes dl à 2
    Rows(x + 1).Insert shift:=xlUp 'ajoute une première ligne
    Rows(x + 1).Insert shift:=xlUp 'ajoute une seconde ligne
    Rows(x).Copy Destination:=Rows(x + 1) 'copy sur la première ligne
    Rows(x).Copy Destination:=Rows(x + 2) 'copy sur la seconde ligne
    Range(Cells(x + 1, 10), Cells(x + 2, 10)).ClearContents 'efface les cellule de la colonne J
    Cells(x + 2, 11).ClearContents 'efface la cellule de la colonne K (de la seconde ligne uniquement ???)
    Cells(x + 1, 15).FormulaR1C1 = "=CONCATENATE(RC[-6],RC[-4])" 'place les formules
    Cells(x + 2, 15).FormulaR1C1 = "=CONCATENATE(RC[-6],RC[-3])" 'place les formules
Next x 'prochaine ligne de la boucle
End Sub

 

[Cousinhub]

Re : Macro : appliquer aux lignes suivantes

Bonjour,

essaie avec ce code :

For i = [A65000].End(xlUp).Row To 3 Step -1
    Rows(i + 1 & ":" & i + 2).Insert Shift:=xlDown
    Rows(i).Copy Rows(i + 1 & ":" & i + 2)
    Union(Cells(i + 1, 10), Cells(i + 2, 10), Cells(i + 2, 11)).ClearContents
    Cells(i + 1, 14).Value = Cells(i + 1, 9).Value & Cells(i + 1, 11).Value
    Cells(i + 2, 14).Value = Cells(i + 2, 9).Value & Cells(i + 1, 12).Value
Next i

Edit : Euh, un peu à la bourre, moi
Salut Robert

 

[Ptikafe]

Re : Macro : appliquer aux lignes suivantes

Merci beaucoup Robert, tes lignes de programmation marchent impeccablement !! 🙂🙂🙂🙂 Grandiose !!! Pour ta proposition bhbh j'ai remarqué que le résultat de la contaténisation n'a pas marché.

Est-ce que je peux encore abuser de vous ??

Alors, voici : est-il possible que cette meme macro opére une verification avant de s'exécuter, du type, si la cellule XXX est vide alors pas de nouvelle ligne créé. Je vous joins ci-dessous le resultat commenté pour que vous puissiez mieux visualisé ce que je veux dire.

Merci encore.

 

[Robert]

Re : Macro : appliquer aux lignes suivantes

Bonjour Ptikafe, salut BHBH, bonjour le forum,

J'ai rajouté une condition dans la boucle, ça devrait convenir...

Sub Macro2()
Dim dl As Integer 'déclare la variable dl
Dim x As Integer 'déclare la variable x
dl = Range("A65536").End(xlUp).Row 'définit la variable dl
For x = dl To 2 Step -1 'boucle inversée des lignes dl à 2
 
    'condition : si la cellule de la colonne K ET la cellule de la colonne L ne sont pas vides
    If Cells(x, 11) <> "" And Cells(x, 12) <> "" Then
        Rows(x + 1).Insert shift:=xlUp 'ajoute une première ligne
        Rows(x + 1).Insert shift:=xlUp 'ajoute une seconde ligne
        Rows(x).Copy Destination:=Rows(x + 1) 'copy sur la première ligne
        Rows(x).Copy Destination:=Rows(x + 2) 'copy sur la seconde ligne
        Range(Cells(x + 1, 10), Cells(x + 2, 10)).ClearContents 'efface les cellule de la colonne J
        Cells(x + 2, 11).ClearContents 'efface la cellule de la colonne K (de la seconde ligne uniquement ???)
        Cells(x + 1, 15).FormulaR1C1 = "=CONCATENATE(RC[-6],RC[-4])" 'place les formules
        Cells(x + 2, 15).FormulaR1C1 = "=CONCATENATE(RC[-6],RC[-3])" 'place les formules
    End If 'fin de la condition
 
Next x 'prochaine ligne de la boucle
End Sub