Ajout de nouvelles lignes dans différents tableaux

Le 18/12/2023 à 16:56

Bonjour,

Je suis en train de réaliser une macro, pour ajouter des lignes dans des tableaux placer sur différentes feuilles. En fonction de la valeur d'une certaine case, la macro est censé ajouter une ligne dans le tableaux correspondant.

Voici ma macro :

Sheets("SheetPrincipale").Activate
Secteurs = Range("H4")
If Secteurs = "1" Then
Sheets("Sheet1").Activate
Rows(10).Insert CopyOrigin:=xlFormatFromRightOrBelow

ElseIf Secteurs = "2" Then
Sheets("Sheet2").Activate
Rows(10).Insert CopyOrigin:=xlFormatFromRightOrBelow

ElseIf Secteurs = "3" Then
Sheets("Sheet3").Activate
Rows(10).Insert CopyOrigin:=xlFormatFromRightOrBelow

'ETC... J'ai 7 tableaux en tout

End If

La macro fonctionne mais elle ajoute une ligne sur "SheetPrincipale", et non sur les autres feuilles. Étant encore débutant sur VBA, est ce que quelqu'un aurait l'amabilité de me dire ce qui cloche dans mon programme ?

Bien à vous.

Le 18/12/2023 à 17:09

Salut,

As-tu bien lu la documentation de Crosoft concernant If...ElseIf...Else...End If ? A mon avis non.

Donc bien lire la documentation avant toute chose. Instruction If...Then...Else (VBA) | Microsoft Learn

De plus nul besoin d'activer une feuille pour en modifier son contenu exemple : Sheets("Sheet1").Rows(10).Insert CopyOrigin:=xlFormatFromRightOrBelow

Donc dans ton cas tu fais 7 blocs If....End If différents et c'est tout

Le 18/12/2023 à 17:10

Bonjour

1) enchainer les if n'est pas une bonne solution

=>il faut utiliser select case bien plus pratique

2) tes tableaux sont ils structurés ? (Insertion Tableaux, avec entete)

3) Tes tableaux n'ont pas forcement tous le même nombre de lignes...... donc il faut trouver la derniere ligne qui n'est pas en Row 9 ou 10 avant de l'étendre d'une ligne:.....

4) ta fonction recopie de reprend que le format.... de quoi

Un bout de fichier me semble nécessaire avec 3 ou 4 onglets

Cordialement

FINDRH

Le 18/12/2023 à 18:03

Re,

FindDR pour son cas il fait une insertion donc le nombre de lignes importe peux.

Avec un sélect case c'est le même problème un seul bloc est évalué.

Donc deux solutions si tu veux intercepter le changement de la cellule H4 de la SheetPrincipale c'est dans la méthode Change de SheetPrincipale que cela se passe.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("H4"), Target) Is Nothing Then
        TestInsertRow (CLng(Target.Value))
    End If
End Sub

Private Sub TestInsertRow(Secteur As Long)
    If Secteur > 0 And Secteur < 8 Then
        ThisWorkbook.Worksheets.Item("Sheet" & CStr(Secteur)).Rows(10).Insert CopyOrigin:=xlFormatFromRightOrBelow
    End If
End Sub

Si c'est sur un bouton alors tu affectes au bouton cette sub

' // A mettre dans un module,mais que si la première méthode n'est pas utilisée
Public Sub TestInsertRow()
    Dim Secteur  As Long
    Secteur = CLng(ThisWorkbook.Worksheets.Item("SheetPrincipale").Range("H4").Value)
    If Secteur > 0 And Secteur < 8 Then
        ThisWorkbook.Worksheets.Item("Sheet" & CStr(Secteur)).Rows(10).Insert CopyOrigin:=xlFormatFromRightOrBelow
    End If
End Sub

Maintenant cela reste minimaliste, garder le nom des feuilles d'origine n'est pas très bon.

Le 19/12/2023 à 08:49

Bonjour Jean Paul et Gasparito 1

Rien a rajouter si ce n'est que j'aime bien comprendre et la demande et donc la structure effective du fichier et des onglets...

Cela m'évite de me lancer inutilement sur des bases incomprises.

La notion de l'existence de tableau structuré ne me semble pas neutre, eu égard à la question récente d'un membre hier qui se heurte ( et ce 'est pas le seul) à des bugs incompréhensible...

Si ta solution convient cela ne mepose pas de problème d'autant plus que j'y ai trouvé une nouvelle façon d'ajouter une ligne !

Cordialement

FINDRH

Le 19/12/2023 à 09:20

Bonjour Jean-Paul et FindRH, tout d'abord merci pour vos réponses aussi rapides !

J'ai réessayé avec la première méthode et cela fonctionne parfaitement. Effectivement je n'avais pas bien compris le principe des instructions If Then Else.

Mon code ressemble maintenant à ça :

Sheets("SheetPrincipale").Select
Secteurs = Range("H4")
If Secteurs = "Sheet1" Then
Sheets("Sheet1").Rows(11).Insert CopyOrigin:=xlFormatFromRightOrBelow
Sheets("Sheet1").Range("A11:C11") = Sheets("SheetPrincipale").Range("E4:G4").Value
Sheets("Sheet1").Range("D11") = Sheets("SheetPrincipale").Range("J4").Value

End If

If Secteurs = "Sheet2" Then
Sheets("Sheet2").Rows(11).Insert CopyOrigin:=xlFormatFromRightOrBelow
Sheets("Sheet2").Range("A11:C11") = Sheets("SheetPrincipale").Range("E4:G4").Value
Sheets("Sheet2").Range("D11") = Sheets("SheetPrincipale").Range("J4").Value
End If

If Secteurs = "Sheet3" Then
Sheets("Sheet3").Rows(11).Insert CopyOrigin:=xlFormatFromRightOrBelow
Sheets("Sheet3").Range("A11:C11") = Sheets("SheetPrincipale").Range("E4:G4").Value
Sheets("Sheet3").Range("D11") = Sheets("SheetPrincipale").Range("J4").Value
End If

If Secteurs = "Sheet4" Then
Sheets("Sheet4").Rows(11).Insert CopyOrigin:=xlFormatFromRightOrBelow
Sheets("Sheet4").Range("A11:C11") = Sheets("SheetPrincipale").Range("E4:G4").Value
Sheets("Sheet4").Range("D11") = Sheets("SheetPrincipale").Range("J4").Value
End If

If Secteurs = "Sheet5" Then
Sheets("Sheet5").Rows(11).Insert CopyOrigin:=xlFormatFromRightOrBelow
Sheets("Sheet5").Range("A11:C11") = Sheets("SheetPrincipale").Range("E4:G4").Value
Sheets("Sheet5").Range("D11") = Sheets("SheetPrincipale").Range("J4").Value
End If

If Secteurs = "Sheet6" Then
Sheets("Sheet6").Rows(11).Insert CopyOrigin:=xlFormatFromRightOrBelow
Sheets("Sheet6").Range("A11:C11") = Sheets("SheetPrincipale").Range("E4:G4").Value
Sheets("Sheet6").Range("D11") = Sheets("SheetPrincipale").Range("J4").Value
End If

If Secteurs = "Sheet7" Then
Sheets("Sheet7").Rows(11).Insert CopyOrigin:=xlFormatFromRightOrBelow
Sheets("Sheet7").Range("A11:C11") = Sheets("SheetPrincipale").Range("E4:G4").Value
Sheets("Sheet7").Range("D11") = Sheets("SheetPrincipale").Range("J4").Value
End If

Merci pour votre aide !

Le 19/12/2023 à 09:29

Salut FindRH,

C'est toujours bien de comprendre le code que l'on nous envoie, et la structure du fichier. Je sui d'accord avec toi.

Concernant les tableaux structurés, et leur fonctionnement. Je peux t'assurer que les utilisant au quotidien cela tourne bien. Maintenant au vu des codes que je vois passer sur la toile, je me doute bien que certains ont des soucis. Mais souvent, et je dirais même quasi tout le temps, la faute n'est pas à imputer à Excel, mais bien à ceux qui le programment. Je vois beaucoup de Range("A25") = "toto". Ca ne marche pas je ne comprends pas pourquoi ? Excel est arrangeant mais il y a des limites tout de même.

Pour son cas il est vrai qu'avant de faire une insertion, la vérification du nombre de ligne peut s'avérer judicieux et empêcher un message d'erreur impromptu.

Et pour finir, n'oublions pas que nous sommes là pour mettre les gens sur la piste, et pas leur pondre la totalité d'un code, ce que beaucoup, ont tendance à oublier.

Bonne prog.

Le 19/12/2023 à 13:12

Bonjour à tous

Code paresseux avec select case..... pour le fun

Sheets("SheetPrincipale").Select
Secteurs = Range("H4").Value

Sheets("SheetPrincipale").Select
Secteurs = Range("H4").Value

Select Case Secteurs

    Case "Sheet1"
        Sheets("Sheet1").Rows(11).Insert CopyOrigin:=xlFormatFromRightOrBelow
        Sheets("Sheet1").Range("A11:C11") = Sheets("SheetPrincipale").Range("E4:G4").Value
        Sheets("Sheet1").Range("D11") = Sheets("SheetPrincipale").Range("J4").Value

    Case "Sheet2"
        Sheets("Sheet2").Rows(11).Insert CopyOrigin:=xlFormatFromRightOrBelow
        Sheets("Sheet2").Range("A11:C11") = Sheets("SheetPrincipale").Range("E4:G4").Value
        Sheets("Sheet2").Range("D11") = Sheets("SheetPrincipale").Range("J4").Value

    Case "Sheet3"
        Sheets("Sheet3").Rows(11).Insert CopyOrigin:=xlFormatFromRightOrBelow
        Sheets("Sheet3").Range("A11:C11") = Sheets("SheetPrincipale").Range("E4:G4").Value
        Sheets("Sheet3").Range("D11") = Sheets("SheetPrincipale").Range("J4").Value

    Case "Sheet4"
        Sheets("Sheet4").Rows(11).Insert CopyOrigin:=xlFormatFromRightOrBelow
        Sheets("Sheet4").Range("A11:C11") = Sheets("SheetPrincipale").Range("E4:G4").Value
        Sheets("Sheet4").Range("D11") = Sheets("SheetPrincipale").Range("J4").Value

    Case "Sheet5"
        Sheets("Sheet5").Rows(11).Insert CopyOrigin:=xlFormatFromRightOrBelow
        Sheets("Sheet5").Range("A11:C11") = Sheets("SheetPrincipale").Range("E4:G4").Value
        Sheets("Sheet5").Range("D11") = Sheets("SheetPrincipale").Range("J4").Value

    Case "Sheet6"
        Sheets("Sheet6").Rows(11).Insert CopyOrigin:=xlFormatFromRightOrBelow
        Sheets("Sheet6").Range("A11:C11") = Sheets("SheetPrincipale").Range("E4:G4").Value
        Sheets("Sheet6").Range("D11") = Sheets("SheetPrincipale").Range("J4").Value

    Case "Sheet7"
        Sheets("Sheet7").Rows(11).Insert CopyOrigin:=xlFormatFromRightOrBelow
        Sheets("Sheet7").Range("A11:C11") = Sheets("SheetPrincipale").Range("E4:G4").Value
        Sheets("Sheet7").Range("D11") = Sheets("SheetPrincipale").Range("J4").Value

    Case Else

End Select

Si les feuilles sont numérotées Feuil1 à Feuil7 on doit pouvoir faire plus court

Bonne journée

Cordialement

FINDRH

Le 19/12/2023 à 13:26

Salut FindRH,

C'est bien de chercher, mais là c'est encore un coup de pied dans l'eau. Le code que tu propose ne correspond pas à sa demande initiale :

Sheets("SheetPrincipale").Activate
Secteurs = Range("H4")
If Secteurs = "1" Then
Sheets("Sheet1").Activate
Rows(10).Insert CopyOrigin:=xlFormatFromRightOrBelow

Il ne teste pas si la valeur de secteurs est "Sheet1" mais si secteurs = "1"

Donc Macro à revoir...

Le 19/12/2023 à 13:40

Je sais, j'ai simpleme,nt voulu lui montrer l'intéret de select case pour economiser les si

Cordialement

FINDRH

Rechercher des sujets similaires à "ajout nouvelles lignes differents tableaux"