Macro pour ajouter une ligne dans plusieurs onglets [Résolu]

Xcited

XLDnaute Nouveau
Bonjour,

Voilà, je débute en VBA et tente mes premières armes avec une macro qui pourrait m'être fort utile dans certaine tâches que je réalise.

L'idée c'est de partir d'un tableau comportant le nom de tous les onglets qu'il faut pouvoir modifier.

La macro doit parcourir la liste de ce tableau pour insérer une ligne dans chaque onglet dont le nom figure dans ce tableau.

Ladite ligne est toujours insérée en bas de liste de données de chaque onglet, avec un format différent en fonction que le numéro de la ligne soit pair ou impair (ça c'est plus gadget qu'autre chose !).

Seulement, VBA stoppe net à la ligne coloriée en jaune.

Code:
Sub Bouton2_QuandClic()

    Dim j As Integer
    Dim Onglet As Object
    Dim Derligne As Object
    Dim Noligne As Object
    
    For j = 5 To ThisWorkbook.Worksheets("Suivi").Range("D5").End(xlDown).Row
          Set Onglet = ThisWorkbook.Worksheets("Suivi").Range("D" & j)
[COLOR="Yellow"]          Set Derligne = ThisWorkbook.Worksheets(Onglet).Range("A65535").End(xlUp)[/COLOR]
          
          ThisWorkbook.Worksheets(Onglet).Range("6:6").Copy
          Derligne.Offset(2, 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
          
          Set Noligne = ThisWorkbook.Worksheets(Onglet).Range("A65535").End(xlUp).Row
          
          Lignepair = Noligne Mod 2
          
          If Lignepair = 0 Then
          
          Derligne.Offset(2, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
          
          Else
          
          ThisWorkbook.Worksheets(Onglet).Range("7:7").Copy
          Derligne.Offset(2, 1).PasteSpecial Paste:=xlPasteFormats,                                                   Operation:=xlNone, _
          SkipBlanks:=False, Transpose:=False
          
          End If
          
    Next j
    
End Sub

Et puis au passage si des choses sont à revoir dans le code, je suis preneur :)

Et il y aura surement beaucoup à redire !

Par avance merci !!

PS je mettrai une PJ un peu plus tard !
 

Pièces jointes

  • Duplication ligne test.xls
    36.5 KB · Affichages: 105
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : Macro pour ajouter une ligne dans plusieurs onglets

Bonsoir Xcited
Si Onglet est un nom d'onglet, essayez en écrivant :
Code:
[COLOR=DarkSlateGray][B]          Set Derligne = ThisWorkbook.Worksheets([COLOR=Red]"[/COLOR]Onglet[COLOR=Red]"[/COLOR]).Range("A65535").End(xlUp)[/B][/COLOR]
ROGER2327
#4630


Dimanche 1er Sable 138 (Noces de Balkis et de Salomon, ST)
11 Frimaire An CCXIX
2010-W48-3T17:48:04Z
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Macro pour ajouter une ligne dans plusieurs onglets

Bonsoir le fil, bonsoir le forum,

En reprenant les deux idées de Softmama et Roger :

Code:
Dim Onglet As String
Set Derligne = ThisWorkbook.Worksheets("Onglet").Range("A65535").End(xlUp)
 

Xcited

XLDnaute Nouveau
Re : Macro pour ajouter une ligne dans plusieurs onglets

Bonjour à tous, merci de vos réponses ! Quelle réactivité :)

J'ai ajouté la pièce jointe !

La variable "Onglet" doit prendre pour valeur le nom de chaque onglet précisé dans un petit tableau dans l'onglet "Suivi".

D'autres messages d'erreur font leur apparition si j'apporte les modifications précisées, peut-être la présence du classeur vous permettront de m'aiguiller !

Erreur : Objet requis sur la ligne

Code:
          Set Onglet = ThisWorkbook.Worksheets("Suivi").Range("D" & j)

Merci encore !
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : Macro pour ajouter une ligne dans plusieurs onglets

Re...
Ceci, peut-être ?
Code:
[COLOR=DarkSlateGray][B]Sub Bouton2_QuandClic()
Dim j As Long
Dim Onglet As String
Dim Derligne As Range
Dim Noligne As Long
Dim Lignepair As Integer
  For j = 5 To ThisWorkbook.Worksheets("Suivi").Range("D5").End(xlDown).Row
    Onglet = ThisWorkbook.Worksheets("Suivi").Range("D" & j)
    Set Derligne = ThisWorkbook.Worksheets(Onglet).Range("A65535").End(xlUp)
    ThisWorkbook.Worksheets(Onglet).Range("6:6").Copy
    Derligne.Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
    Noligne = ThisWorkbook.Worksheets(Onglet).Range("A65535").End(xlUp).Row
    Lignepair = Noligne Mod 2
    If Lignepair = 0 Then
      Derligne.Offset(1, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Else
      ThisWorkbook.Worksheets(Onglet).Range("7:7").Copy
      Derligne.Offset(1, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    End If
  Next j
End Sub[/B][/COLOR]
ROGER2327
#4634


Dimanche 1er Sable 138 (Noces de Balkis et de Salomon, ST)
11 Frimaire An CCXIX
2010-W48-3T22:02:28Z
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG