Code VBA agissant sur 2 feuilles

Résolu
Viking58 Messages postés 186 Date d'inscription   Statut Membre Dernière intervention   -  
Viking58 Messages postés 186 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour.

J'ai ce code de Bouton sur ma Feuil1:

'Insérer ligne au dessus ligne A3
Private Sub CommandButton1_Click()
Cells(3, 1).EntireRow.Insert
Rows(Cells(3, 1).Row + 1).Copy Rows(Cells(3, 1).Row)
On Error Resume Next
Rows(Cells(3, 1).Row).SpecialCells(xlCellTypeConstants, 23).ClearContents
Dim plage As Range
Set plage = Range("A3:G3000")
plage.Borders(xlEdgeBottom).LineStyle = xlContinuous
plage.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End Sub

Comment le modifier pour que l'insertion de ligne se produise aussi sur ma Feuil2 , à partir de ce même bouton ?

Merci



--
Windows 8.1 Office 2013

4 réponses

  1. ng4706 Messages postés 400 Statut Membre 1
     
    bonjour

    euh.....je vais dire une GROSSE bêtise....
    en sélectionnant les 2 feuilles (touche CTRL) avant l'insertion ???????
    euh .... en copiant le bouton ????
    0
    1. Viking58 Messages postés 186 Date d'inscription   Statut Membre Dernière intervention   7
       
      Bonjour.
      Je veux qu'en actionnant le bouton qui insère une ligne avec mise en forme de ma Feuil1,
      il se produise la même chose ur ma Feuil2.
      A partir de cet unique bouton.
      0
  2. Frenchie83 Messages postés 2254 Statut Membre 339
     
    Bonjour
    Mettez un bouton de type formulaire (pas activeX) et copier ce code dans un module (pas le module de la feuille)
    Sub InsertLignes()
        For i = 1 To 2
            Sheets("Feuil" & i).Cells(3, 1).EntireRow.Insert
            Sheets("Feuil" & i).Rows(Cells(3, 1).Row + 1).Copy Sheets("Feuil" & i).Rows(Cells(3, 1).Row)
            On Error Resume Next
            Sheets("Feuil" & i).Rows(Cells(3, 1).Row).SpecialCells(xlCellTypeConstants, 23).ClearContents
            Dim plage As Range
            Set plage = Sheets("Feuil" & i).Range("A3:G3000")
            plage.Borders(xlEdgeBottom).LineStyle = xlContinuous
            plage.Borders(xlInsideHorizontal).LineStyle = xlContinuous
        Next i
    End Sub

    Essayez
    Cdlt
    0
  3. Viking58 Messages postés 186 Date d'inscription   Statut Membre Dernière intervention   7
     
    Merci. Fonctionne très bien sur un classeur d'essai, vierge.
    Par contre, sur le classeur ou je dois appliquer ce code:
    Ma Feuil1 s'appelle "Fait le"
    Ma Feuil2 s'appelle "Données"
    Quand j'essaie d'adapter, Excel me renvoie (en gras ici, puisque je ne peux pas mettre de couleur):

    Private Sub CommandButton3_Click()
    'Sub InsertLignes()
    For i = 1 To 2
    Sheets("Fait le" & i).Cells(3, 1).EntireRow.Insert
    Sheets("Fait le" & i).Rows(Cells(3, 1).Row + 1).Copy Sheets("Feuil" & i).Rows(Cells(3, 1).Row)
    On Error Resume Next
    Sheets("Données" & i).Rows(Cells(3, 1).Row).SpecialCells(xlCellTypeConstants, 23).ClearContents
    Dim plage As Range
    Set plage = Sheets("Données" & i).Range("A3:G3000")
    plage.Borders(xlEdgeBottom).LineStyle = xlContinuous
    plage.Borders(xlInsideHorizontal).LineStyle = xlContinuous
    Next i
    End Sub
    0
  4. Frenchie83 Messages postés 2254 Statut Membre 339
     
    Voilà
    Sub InsertLignes()
        For i = 1 To 2
            Sheets(i).Cells(3, 1).EntireRow.Insert
            Sheets(i).Rows(Cells(3, 1).Row + 1).Copy Sheets(i).Rows(Cells(3, 1).Row)
            On Error Resume Next
            Sheets(i).Rows(Cells(3, 1).Row).SpecialCells(xlCellTypeConstants, 23).ClearContents
            Dim plage As Range
            Set plage = Sheets(i).Range("A3:G3000")
            plage.Borders(xlEdgeBottom).LineStyle = xlContinuous
            plage.Borders(xlInsideHorizontal).LineStyle = xlContinuous
        Next
    End Sub

    Cdlt
    0
    1. Viking58 Messages postés 186 Date d'inscription   Statut Membre Dernière intervention   7
       
      Génial...
      Merci Frenchie.
      0