XL 2016 Un petit coup de main pour un code VBA

R

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
 
Trier par date Trier par votes
Hasco

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:
Vote positif 0 Vote négatif
jhijo

jhijo

XLDnaute Nouveau
ReneDav14000 à dit:
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
R

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
Vote positif 0 Vote négatif
R

ReneDav14000

XLDnaute Occasionnel
jhijo à dit:
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
Cliquez pour agrandir...
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:
 
Vote positif 0 Vote négatif
Hasco

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.
ReneDav14000 à dit:
alors j'applique ce que l'on m'apprends.
Cliquez pour agrandir...

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
Vote positif 0 Vote négatif
jhijo

jhijo

XLDnaute Nouveau
ReneDav14000 à dit:
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:
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif
R

ReneDav14000

XLDnaute Occasionnel
Hasco à dit:
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
R

ReneDav14000

XLDnaute Occasionnel
Hasco à dit:
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif

Discussions similaires

pompaero
  • Résolu(e)
Microsoft 365 Amélioration codage
Réponses
4
Affichages
194
pompaero
pompaero
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
63
Latias
L
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
165
Dranreb
Dranreb
R
  • Question
XL 2021 Optimisation Code VBA
Réponses
10
Affichages
364
Dranreb
Dranreb
B
  • Question
Microsoft 365 Additionner des cellules même ligne en userform vba
Réponses
13
Affichages
329
sousou
sousou
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
165
Francky79
F
R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
150
rebatte
R
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
228
florian50470
F
S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
137
souhaib ad
S
S
  • Résolu(e)
XL 2016 Besoin d'aide pour un code d'extraction
Réponses
14
Affichages
264
Phil69970
Phil69970

Membres actuellement en ligne

4 membres et 54 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 106
Messages
2 085 352
Membres
102 871
dernier inscrit
Maïmanko