XL 2016 Un petit coup de main pour un code VBA

ReneDav14000

XLDnaute Occasionnel
Bonjour à tous,
J'ai mis en place le code ci-dessous qui fonctionne à-peu-près bien.
Je m'explique. Ce code est censé coller les données d'une UF dans deux feuilles du classeur ("BDD et Agents").
Le collage se fait bien mais lorsque je saisi une nouvelle entrée et que je clique sur valider, et bien les données déjà saisies sont écrasées par la suivante, je n'arrive pas à mettre les données les unes en-dessous des autres.
J'ai beau lire et relire mon code je ne trouve pas mon erreur, pouvez-vous m'apporter un regard neuf s'il vous plait ?
Je vous en remercie par avance

Voici mon code :
VB:
'Code pour le bouton "Nouvel agent"
Private Sub BoutNew_Click()
Dim L, Ligne As Integer
Dim Var As String

        If TextNum.Value = "" Then
        MsgBox "Vous n'avez pas généré de code-barres pour cet agent."
        Exit Sub
    End If
    
                    Sheets("BDD").Visible = True
                    Sheets("Agents").Visible = True
                    
                             If MsgBox("Confirmez-vous la création de ce nouvel agent ?", vbYesNo, "Demande de confirmation de création") = vbYes Then
    
    'Exportation vers la feuille "Agents"
        
        L = Sheets("Agents").Range("A1048576").End(xlUp).Row
        
        With Sheets("Agents").Select
            Range("A" & L).Value = ComboPoste
            Range("B" & L).Value = ComboCivil
            Range("C" & L).Value = TextBox1
            Range("D" & L).Value = TextBox2
            Range("E" & L).Value = TextBox3
            Range("F" & L).Value = TextBox4
            Range("G" & L).Value = TextBox5
            Range("H" & L).Value = TextBox6
            Range("I" & L).Value = TextBox7
            Range("K" & L).Value = TextBox8
            Range("A:K").Columns.AutoFit
        End With
        
    'Exportation vers la feuille "BDD"
        
         Ligne = Sheets("BDD").Range("A1048576").End(xlUp).Row
      
         With Sheets("BDD").Select
            Range("A" & Ligne).Value = ComboCivil & " " & TextBox1 & " " & TextBox2
            Range("B" & Ligne).Value = ComboPoste
            Range("C" & Ligne).Value = TextNum
            Range("D" & Ligne).Value = Sheets("Calcul").Range("A2").Value
            Range("E" & Ligne).Value = TextBarres
            Range("F" & Ligne).Value = "=RC[-1]"
            Range("M" & Ligne).Value = TextBox8
        End With
        
    End If
    
    Var = Sheets("Accueil").Range("H28").Value
    Var = Var + 1
    Sheets("Accueil").Range("H28").Value = Var
    
End Sub
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonsoir,

VB:
  Ligne = Sheets("BDD").Range("A1048576").End(xlUp).Row + 1

Et n'oubliez pas les points devant les Range (ceux qui appartiennent à BDD) dans
Code:
With Sheets("BDD")
            .Range("A" & Ligne).Value = ComboCivil & " " & TextBox1 & " " & TextBox2
            .Range("B" & Ligne).Value = ComboPoste
            .Range("C" & Ligne).Value = TextNum
            .Range("D" & Ligne).Value = Sheets("Calcul").Range("A2").Value
            .Range("E" & Ligne).Value = TextBarres
            .Range("F" & Ligne).Formula= "=RC[-1]"
            .Range("M" & Ligne).Value = TextBox8
        End With

Si non, la structure With...End with ne sert à rien et si le code est lancé alors qu'une autre feuille est active, ce sera l'autre feuille que sera modifiée

Vous pouvez faire également

Code:
With Sheets("BDD")
             Ligne = .Range("A1048576").End(xlUp).Row + 1
         
.Range("A" & Ligne).Value = ComboCivil & " " & TextBox1 & " " & TextBox2

            .Range("B" & Ligne).Value = ComboPoste

            .Range("C" & Ligne).Value = TextNum

            .Range("D" & Ligne).Value = Sheets("Calcul").Range("A2").Value

            .Range("E" & Ligne).Value = TextBarres

            .Range("F" & Ligne).Formula= "=RC[-1]"

            .Range("M" & Ligne).Value = TextBox8

        End With
Même chose pour la feuille "Agents"
 
Dernière édition:

jhijo

XLDnaute Nouveau
Bonjour à tous,
J'ai mis en place le code ci-dessous qui fonctionne à-peu-près bien.
Je m'explique. Ce code est censé coller les données d'une UF dans deux feuilles du classeur ("BDD et Agents").
Le collage se fait bien mais lorsque je saisi une nouvelle entrée et que je clique sur valider, et bien les données déjà saisies sont écrasées par la suivante, je n'arrive pas à mettre les données les unes en-dessous des autres.
J'ai beau lire et relire mon code je ne trouve pas mon erreur, pouvez-vous m'apporter un regard neuf s'il vous plait ?
Je vous en remercie par avance

Voici mon code :
VB:
'Code pour le bouton "Nouvel agent"
Private Sub BoutNew_Click()
Dim L, Ligne As Integer
Dim Var As String

        If TextNum.Value = "" Then
        MsgBox "Vous n'avez pas généré de code-barres pour cet agent."
        Exit Sub
    End If
  
                    Sheets("BDD").Visible = True
                    Sheets("Agents").Visible = True
                  
                             If MsgBox("Confirmez-vous la création de ce nouvel agent ?", vbYesNo, "Demande de confirmation de création") = vbYes Then
  
    'Exportation vers la feuille "Agents"
      
        L = Sheets("Agents").Range("A1048576").End(xlUp).Row
      
        With Sheets("Agents").Select
            Range("A" & L).Value = ComboPoste
            Range("B" & L).Value = ComboCivil
            Range("C" & L).Value = TextBox1
            Range("D" & L).Value = TextBox2
            Range("E" & L).Value = TextBox3
            Range("F" & L).Value = TextBox4
            Range("G" & L).Value = TextBox5
            Range("H" & L).Value = TextBox6
            Range("I" & L).Value = TextBox7
            Range("K" & L).Value = TextBox8
            Range("A:K").Columns.AutoFit
        End With
      
    'Exportation vers la feuille "BDD"
      
         Ligne = Sheets("BDD").Range("A1048576").End(xlUp).Row
    
         With Sheets("BDD").Select
            Range("A" & Ligne).Value = ComboCivil & " " & TextBox1 & " " & TextBox2
            Range("B" & Ligne).Value = ComboPoste
            Range("C" & Ligne).Value = TextNum
            Range("D" & Ligne).Value = Sheets("Calcul").Range("A2").Value
            Range("E" & Ligne).Value = TextBarres
            Range("F" & Ligne).Value = "=RC[-1]"
            Range("M" & Ligne).Value = TextBox8
        End With
      
    End If
  
    Var = Sheets("Accueil").Range("H28").Value
    Var = Var + 1
    Sheets("Accueil").Range("H28").Value = Var
  
End Sub
Bonjour,
Il est difficile de se représenter un morceau de code sans voir la ou les feuilles concernées...
Mais à première vue, je dirais que ta variable L n'est pas incrémentée pour insérer les valeurs sur la ligne suivante. De plus, je ne comprends pas cette recherche de ligne vide depuis le bas pour calculer L
L = Sheets("Agents").Range("A1048576").End(xlUp).Row
Ne serait-il pas mieux de rechercher L en débutant par le haut du style
L = Sheets("Agents").Range("A1").End(xlDown).Row
 

ReneDav14000

XLDnaute Occasionnel
Bonsoir Hasco,
Merci pour votre réponse, mais ça ne fonctionne pas.
Les données viennent bien les unes en-dessous des autres, mais pas dès la premières lignes vides.
je mets mon fichier en pièce jointe.
 

Pièces jointes

  • Gestion_Heures_Camping_YB.xlsm
    419 KB · Affichages: 4

ReneDav14000

XLDnaute Occasionnel
Bonjour,
Il est difficile de se représenter un morceau de code sans voir la ou les feuilles concernées...
Mais à première vue, je dirais que ta variable L n'est pas incrémentée pour insérer les valeurs sur la ligne suivante. De plus, je ne comprends pas cette recherche de ligne vide depuis le bas pour calculer L
L = Sheets("Agents").Range("A1048576").End(xlUp).Row
Ne serait-il pas mieux de rechercher L en débutant par le haut du style
L = Sheets("Agents").Range("A1").End(xlDown).Row
Bonsoir jhijo
Merci pour votre réponse. J'ai procédé ainsi car on m'a toujours expliqué que c'était mieux de commencer par le bas, alors j'applique ce que l'on m'apprends.
Si on a une cellule vide dans la colonne, il s'arrêtera avant la fin, donc il est parfois préférable de partir du bas de la feuille de calcul et de remonter. :rolleyes:
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonsoir,

Vous auriez donné votre fichier exemple dès le premier post on aurait perdu moins de temps !
On se demande comment il faut le dire, de joindre un fichier à la demande.
J'aurais vu que vos données étaient en tableaux structurés ce qui ne se gère pas comme une plage de données ordinaire.
C'est ça qui vous empêchait d'avoir la dernière ligne vide de la colonne.
alors j'applique ce que l'on m'apprends.

Avant d'appliquer, il faut comprendre.


Il vous faudra faire un test pour savoir si l'agent n'existe pas déjà dans la BDD

Votre code du bouton :
VB:
'Code pour le bouton "Nouvel agent"
Private Sub BoutNew_Click()
    Dim Ligne As Range
    Dim Var As String

    If TextNum.Value = "" Then
        MsgBox "Vous n'avez pas généré de code-barres pour cet agent."
        Exit Sub
    End If

    Sheets("BDD").Visible = True
    Sheets("Agents").Visible = True

    If MsgBox("Confirmez-vous la création de ce nouvel agent ?", vbYesNo, "Demande de confirmation de création") = vbYes Then

        'Exportation vers la feuille "Agents"


        With Sheets("Agents").ListObjects(1)

            If .InsertRowRange Is Nothing Then
                Set Ligne = .ListRows.Add().Range
            Else
                Set Ligne = .InsertRowRange
            End If
        End With

        Ligne(1, 1).Value = ComboPoste
        Ligne(1, 2).Value = ComboCivil
        Ligne(1, 3).Value = TextBox1
        Ligne(1, 4).Value = TextBox2
        Ligne(1, 5).Value = TextBox3
        Ligne(1, 6).Value = TextBox4
        Ligne(1, 7).Value = TextBox5
        Ligne(1, 8).Value = TextBox6
        Ligne(1, 9).Value = TextBox7
        Ligne(1, 10).Value = TextBox8

        Set Ligne = Nothing

        'Exportation vers la feuille "BDD"

        With Sheets("BDD").ListObjects(1)

            If .InsertRowRange Is Nothing Then
                Set Ligne = .ListRows.Add().Range
            Else
                Set Ligne = .InsertRowRange
            End If
        End With
        
        Ligne(1, 1).Value = ComboCivil & " " & TextBox1 & " " & TextBox2
        Ligne(1, 2).Value = ComboPoste
        Ligne(1, 3).Value = TextNum
        Ligne(1, 4).Value = Sheets("Calcul").Range("A2").Value
        Ligne(1, 5).Value = TextBarres
        Ligne(1, 6).Formula = "=RC[-1]"
        Ligne(1, 7).Value = TextBox8


        Var = Sheets("Accueil").Range("H28").Value
        Var = Var + 1
        Sheets("Accueil").Range("H28").Value = Var
    End If
End Sub
 

Pièces jointes

  • Planning essais 2.xlsm
    309 KB · Affichages: 2

jhijo

XLDnaute Nouveau
Bonsoir jhijo
Merci pour votre réponse. J'ai procédé ainsi car on m'a toujours expliqué que c'était mieux de commencer par le bas, alors j'applique ce que l'on m'apprends.
Si on a une cellule vide dans la colonne, il s'arrêtera avant la fin, donc il est parfois préférable de partir du bas de la feuille de calcul et de remonter. :rolleyes:
J'essaye simplement de comprendre votre code...
Je viens de tester votre classeur avec l'incrémentation de L comme l'a stipulé Hasco.
Cela fonctionne parfaitement. Que l'on conserve le formulaire ouvert ou pas.
 

ReneDav14000

XLDnaute Occasionnel
Bonsoir,

Vous auriez donné votre fichier exemple dès le premier post on aurait perdu moins de temps !
On se demande comment il faut le dire, de joindre un fichier à la demande.
J'aurais vu que vos données étaient en tableaux structurés ce qui ne se gère pas comme une plage de données ordinaire.
C'est ça qui vous empêchait d'avoir la dernière ligne vide de la colonne.


Avant d'appliquer, il faut comprendre.


Il vous faudra faire un test pour savoir si l'agent n'existe pas déjà dans la BDD

Votre code du bouton :
VB:
'Code pour le bouton "Nouvel agent"
Private Sub BoutNew_Click()
    Dim Ligne As Range
    Dim Var As String

    If TextNum.Value = "" Then
        MsgBox "Vous n'avez pas généré de code-barres pour cet agent."
        Exit Sub
    End If

    Sheets("BDD").Visible = True
    Sheets("Agents").Visible = True

    If MsgBox("Confirmez-vous la création de ce nouvel agent ?", vbYesNo, "Demande de confirmation de création") = vbYes Then

        'Exportation vers la feuille "Agents"


        With Sheets("Agents").ListObjects(1)

            If .InsertRowRange Is Nothing Then
                Set Ligne = .ListRows.Add().Range
            Else
                Set Ligne = .InsertRowRange
            End If
        End With

        Ligne(1, 1).Value = ComboPoste
        Ligne(1, 2).Value = ComboCivil
        Ligne(1, 3).Value = TextBox1
        Ligne(1, 4).Value = TextBox2
        Ligne(1, 5).Value = TextBox3
        Ligne(1, 6).Value = TextBox4
        Ligne(1, 7).Value = TextBox5
        Ligne(1, 8).Value = TextBox6
        Ligne(1, 9).Value = TextBox7
        Ligne(1, 10).Value = TextBox8

        Set Ligne = Nothing

        'Exportation vers la feuille "BDD"

        With Sheets("BDD").ListObjects(1)

            If .InsertRowRange Is Nothing Then
                Set Ligne = .ListRows.Add().Range
            Else
                Set Ligne = .InsertRowRange
            End If
        End With
       
        Ligne(1, 1).Value = ComboCivil & " " & TextBox1 & " " & TextBox2
        Ligne(1, 2).Value = ComboPoste
        Ligne(1, 3).Value = TextNum
        Ligne(1, 4).Value = Sheets("Calcul").Range("A2").Value
        Ligne(1, 5).Value = TextBarres
        Ligne(1, 6).Formula = "=RC[-1]"
        Ligne(1, 7).Value = TextBox8


        Var = Sheets("Accueil").Range("H28").Value
        Var = Var + 1
        Sheets("Accueil").Range("H28").Value = Var
    End If
End Sub
Merci beaucoup pour votre aide.
Il est vrai que je devrais avoir le reflex pièce jointe. Je comprends ce que je fais, mais j'avais oublié que je travaillais avec des tableaux structurés, je me suis déjà fait avoir avec ça.
Merci encore
 

ReneDav14000

XLDnaute Occasionnel
Bonsoir,

Vous auriez donné votre fichier exemple dès le premier post on aurait perdu moins de temps !
On se demande comment il faut le dire, de joindre un fichier à la demande.
J'aurais vu que vos données étaient en tableaux structurés ce qui ne se gère pas comme une plage de données ordinaire.
C'est ça qui vous empêchait d'avoir la dernière ligne vide de la colonne.


Avant d'appliquer, il faut comprendre.


Il vous faudra faire un test pour savoir si l'agent n'existe pas déjà dans la BDD

Votre code du bouton :
VB:
'Code pour le bouton "Nouvel agent"
Private Sub BoutNew_Click()
    Dim Ligne As Range
    Dim Var As String

    If TextNum.Value = "" Then
        MsgBox "Vous n'avez pas généré de code-barres pour cet agent."
        Exit Sub
    End If

    Sheets("BDD").Visible = True
    Sheets("Agents").Visible = True

    If MsgBox("Confirmez-vous la création de ce nouvel agent ?", vbYesNo, "Demande de confirmation de création") = vbYes Then

        'Exportation vers la feuille "Agents"


        With Sheets("Agents").ListObjects(1)

            If .InsertRowRange Is Nothing Then
                Set Ligne = .ListRows.Add().Range
            Else
                Set Ligne = .InsertRowRange
            End If
        End With

        Ligne(1, 1).Value = ComboPoste
        Ligne(1, 2).Value = ComboCivil
        Ligne(1, 3).Value = TextBox1
        Ligne(1, 4).Value = TextBox2
        Ligne(1, 5).Value = TextBox3
        Ligne(1, 6).Value = TextBox4
        Ligne(1, 7).Value = TextBox5
        Ligne(1, 8).Value = TextBox6
        Ligne(1, 9).Value = TextBox7
        Ligne(1, 10).Value = TextBox8

        Set Ligne = Nothing

        'Exportation vers la feuille "BDD"

        With Sheets("BDD").ListObjects(1)

            If .InsertRowRange Is Nothing Then
                Set Ligne = .ListRows.Add().Range
            Else
                Set Ligne = .InsertRowRange
            End If
        End With
      
        Ligne(1, 1).Value = ComboCivil & " " & TextBox1 & " " & TextBox2
        Ligne(1, 2).Value = ComboPoste
        Ligne(1, 3).Value = TextNum
        Ligne(1, 4).Value = Sheets("Calcul").Range("A2").Value
        Ligne(1, 5).Value = TextBarres
        Ligne(1, 6).Formula = "=RC[-1]"
        Ligne(1, 7).Value = TextBox8


        Var = Sheets("Accueil").Range("H28").Value
        Var = Var + 1
        Sheets("Accueil").Range("H28").Value = Var
    End If
End Sub
Désolé, mais ça ne fonctionne pas chez moi. Les données arrivent sur une 2ème ligne laissant la première vide pour les deux feuilles. J'avais pensé que le fait qu'il ait une formule sur la ligne puisse empêcher le bon fonctionnement, mais seule la feuille "Agents" à une formule en J.
Je vais essayer de trouver la source de mon erreur.
Pourquoi votre fichier joint ? je ne comprends pas le rapport avec mon fichier.
Encore merci pour votre code
 

Statistiques des forums

Discussions
313 222
Messages
2 096 333
Membres
106 571
dernier inscrit
Domdom24