XL 2010 Macros insérer une ligne en recopiant formule dans plusieurs feuilles

deva

XLDnaute Nouveau
Bonjour à tous,

Je viens vous solliciter pour un petit soucis technique.

J'aimerai créer une macro qui insère une ligne (au préalable demandée) et qui récupère le format et les formules de la ligne du dessus. J'aimerai que cette ligne soit insérée dans plusieurs feuilles de mon fichier.

Private Sub CommandButton14_Click()
Dim Ligne As Long
Dim lRsp As Long
On Error Resume Next

Ligne = InputBox("Numéro de la ligne à inserer ? ")
lRsp = MsgBox("Insérer une nouvelle ligne au-dessus de la ligne " & Ligne & "?", _
vbQuestion + vbYesNo)
If lRsp <> vbYes Then Exit Sub

Rows(Ligne).Select
Selection.Copy
Rows(Ligne + 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False

'Paste formulas and conditional formatting in new row created
Rows(Ligne).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone

End Sub

Je suis rendue là. Le problème c'est que je n'arrive pas à insérer cette ligne sur toutes mes feuilles.
J'espère avoir été claire.
Merci à tous de votre aide.
Bonne journée :)
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Deva, et bienvenu(e) sur XLD,
Pour le code utilisez la baise </> c'est plus lisible ( à droite de l'icone GIF )
Essayez de fournir un petit fichier test représentatif, ce serait plus parlant.
Ensuite, la copie doit elle s'effectuée sur toutes les feuilles ?
Doit on copier toute la ligne ou peut on se limiter à un certain nombre de cellules ?
 

deva

XLDnaute Nouveau
Bonjour, merci de votre réponse 😊

voici le code :

VB:
Private Sub CommandButton14_Click()
    Dim ws As Worksheet
    Dim Ligne As Long
    Dim lRsp As Long
    On Error Resume Next

    Ligne = InputBox("Numéro de la ligne à inserer ? ")
    lRsp = MsgBox("Insérer une nouvelle ligne au-dessus de la ligne " & Ligne & "?", _
            vbQuestion + vbYesNo)
    If lRsp <> vbYes Then Exit Sub
For Each ws In Worksheet
    Rows(Ligne).Select
    Selection.Copy
    Rows(Ligne + 1).Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    
   'Paste formulas and conditional formatting in new row created
    Rows(Ligne).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone
    
Next ws

End Sub

La copie ne doit s'effectuée que sur certaines feuilles et oui j'aimerai bien copier toute la ligne.

Je mets ci-joint un fichier représentatif
 

Pièces jointes

  • test.xlsx
    31.6 KB · Affichages: 4

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Deva,
Worksheet prend un "s" pour toutes les parcourir sinon on reste sur la feuille active.
VB:
For Each ws In Worksheets
Il faut préciser sur quelle feuille on veut travailler
Code:
With Sheets(ws.Name)
Soit avec un With (plus simple) soit en faisant précéder les instructions par Sheets(ws.Name).xxx
Code:
Private Sub CommandButton14_Click()
    Dim ws As Worksheet
    Dim Ligne As Long
    Dim lRsp As Long
    On Error Resume Next

    Ligne = InputBox("Numéro de la ligne à inserer ? ")
    lRsp = MsgBox("Insérer une nouvelle ligne au-dessus de la ligne " & Ligne & "?", _
            vbQuestion + vbYesNo)
    If lRsp <> vbYes Then Exit Sub
For Each ws In Worksheets             
    With Sheets(ws.Name)
        .Rows(Ligne).Copy                  
        .Rows(Ligne + 1).Select
        Selection.Insert Shift:=xlDown
        Application.CutCopyMode = False
        'Paste formulas and conditional formatting in new row created
        .Rows(Ligne).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone
    End With
Next ws

End Sub
En espérant que cela fasse bien ce que vous voulez que ça fasse. ;)
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Si le fichier utilisé n'est pas strictement représentatif alors difficile d'extrapoler une quelconque explication.
Normalement avec un "For Each ws In Worksheets" il parcourt chaque feuille.
En PJ un fichier simplifié de 15 feuilles.
L'insertion se fait correctement sur les 15 feuilles.
 

Pièces jointes

  • EssaiDeva.xlsm
    31.1 KB · Affichages: 1

Discussions similaires

Statistiques des forums

Discussions
313 282
Messages
2 096 789
Membres
106 748
dernier inscrit
Abdel93