VBA Remplir des cellules de feuilles différentes

Le 12/07/2018 à 12:38

Bonjour,

Je cherche à remplir simultanément deux feuilles par des données entrées par l'utilisateur.

Ici : Pour un "code plante" choisi, l'utilisateur peut entrer des informations sur la récolte d'une plante. Trois récoltes successives peuvent avoir lieu. Aussi, j'aimerais que la première récolte soit stockée à la fois dans la feuille "BDD" (name: recap) et dans la feuille "Récolte" (name : recolte), tandis que les deux autres récoltes doivent être stockées dans Récolte seulement.

Pour le moment, pas de problème pour que les données se mettent dans BDD, en revanche rien ne se passe pour Récolte, et je ne comprends pas pourquoi... En même temps je suis novice en la matière, toute aide sera donc plus que bienvenue!

Je vous remercie par avance ! Voici le code :

Option Explicit
Dim ws As Worksheet
Dim i As Long
Dim j As Long
Dim lastrow As Long
Dim lastrow2 As Long
Dim codelist As List
Dim codePlantes As String

Private Sub CommandButton1_Click()
    Dim L As Integer
    Dim lastrow As Long
    Dim i As Long
    Dim element As Variant
    Dim msgErreur As String
    Dim nbErreur As Integer

    If MsgBox("Etes-vous certain de vouloir ajouter ces informations?", vbYesNo, "Demande de confirmation") = vbYes Then 'condition : si oui au message
        Set ws = Sheets("BDD")

        ws.Unprotect

    recolte.Unprotect

    nbErreur = 0
    msgErreur = "Merci de vérifier :" & vbCrLf

    If CB_code.value = "" Then
        nbErreur = nbErreur + 1
        msgErreur = msgErreur & " - Code de la plante obligatoire" & vbCrLf
    End If

lastrow = recap.Range("b1048576").End(xlUp).Row
    For i = 2 To lastrow

        If recap.Cells(i, 2) = CB_code.value Then
            recap.Range("AI" & i).value = Format(TB_Date, "yyyy-mm-dd")
            recap.Range("AK" & i).value = TB_Poids
            recap.Range("AL" & i).value = TB_Pieds
            recap.Range("AO" & i).value = TB_Capacité

        End If
 Next i

  lastrow2 = recolte.Range("a1048576").End(xlUp).Row
  For j = 2 To lastrow2

    If recolte.Cells(i, 2) = CB_code.value Then
        recolte.Cells("C" & i).value = Format(TB_Date, "yyyy-mm-dd")
        recolte.Cells("E" & i).value = TB_Poids
        recolte.Cells("F" & i).value = TB_Pieds
        recolte.Cells("I" & i).value = TB_Capacité
        recolte.Cells("J" & i).value = Format(TB_Date2, "yyyy-mm-dd")
        recolte.Cells("L" & i).value = TB_Poids2
        recolte.Cells("M" & i).value = TB_Pieds2
        recolte.Cells("P" & i).value = TB_Capacité2
        recolte.Cells("Q" & i).value = Format(TB_Date3, "yyyy-mm-dd")
        recolte.Cells("S" & i).value = TB_Poids3
        recolte.Cells("T" & i).value = TB_Pieds3
        recolte.Cells("W" & i).value = TB_Capacité3

    'Conversion des cellules en format nombre
   recap.Select
   Columns("AK:AK").Select
    Selection.NumberFormat = "0.00"
    Selection.TextToColumns Destination:=Range("AK1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
   Columns("AL:AL").Select
    Selection.NumberFormat = "0"
    Selection.TextToColumns Destination:=Range("AL1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
  Columns("AO:AO").Select
    Selection.NumberFormat = "0"
    Selection.TextToColumns Destination:=Range("AO1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True

        recolte.Select
        Columns("E:E").Select
    Selection.NumberFormat = "0.00"
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
   Columns("F:F").Select
    Selection.NumberFormat = "0"
    Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
  Columns("I:I").Select
    Selection.NumberFormat = "0"
    Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
         End If

Next j

    Call Tri_Plantes
    Call Typographie_Plantes
    MsgBox "Plantes mises à jours, les doublons ont été effacés"
    Range("A1").Select
   ws.Protect
   recolte.Protect

   menu.Select

Unload Me
End If
End Sub

Private Sub CommandButton2_Click()
Dim BDD As Worksheet
    recap.Protect
    Unload Me
End Sub

Private Sub CB_code_Change()
lastrow = recap.Range("b1048576").End(xlUp).Row
lastrow2 = recolte.Range("a1048576").End(xlUp).Row

  For i = 2 To lastrow

    If recap.Cells(i, 2) = CB_code.value Then
        LB_semis = recap.Cells(i, 7).value
        TB_Date = recap.Cells(i, 35).value
        TB_Poids = recap.Cells(i, 37).value
        TB_Pieds = recap.Cells(i, 38).value
        TB_Capacité = recap.Cells(i, 41).value
   End If
   Next i

   For j = 2 To lastrow2

    If recolte.Cells(i, 2) = CB_code.value Then

        TB_Date2 = recolte.Cells(i, 10).value
        TB_Poids2 = recolte.Cells(i, 12).value
        TB_Pieds2 = recolte.Cells(i, 13).value
        TB_Capacité2 = recolte.Cells(i, 16).value
        TB_Date3 = recolte.Cells(i, 17).value
        TB_Poids3 = recolte.Cells(i, 19).value
        TB_Pieds3 = recolte.Cells(i, 20).value
        TB_Capacité3 = recolte.Cells(i, 23).value

   End If

Next j

End Sub
Le 12/07/2018 à 13:43

Bonjour,

pas de fichier, pas de test... Sinon regardez un peu ceci :

 For j = 2 To lastrow2

    If recolte.Cells(i, 2) = CB_code.value Then
        recolte.Cells("C" & i).value = Format(TB_Date, "yyyy-mm-dd")

Vous ouvrez une boucle avec j et la variable dans le code est "i"...

Normal qu'il n'y ait pas "d'incrémentation"....

Et c'est le cas plus loin dans le code...

Ensuite vous dites que BDD est "récap", hors dans le code c'est "BDD"...

Donc une fois de plus sans fichier....

@ bientôt

LouReeD

Le 12/07/2018 à 13:51

Bonjour LouReeD,

Merci de votre réponse. Je narrive pas à joindre le fichier, il est trop lourd, même compressé...

Effectivement des coquilles, j'ai changé entre temps le code, que voici :

Private Sub CommandButton1_Click()
    Dim L As Integer
    Dim lastrow2 As Long
    Dim j As Long
    Dim element As Variant
    Dim msgErreur As String
    Dim nbErreur As Integer
    Dim Wr As Worksheet
    Dim Ws As Worksheet

    If MsgBox("Etes-vous certain de vouloir ajouter ces informations?", vbYesNo, "Demande de confirmation") = vbYes Then 'condition : si oui au message
        Set Wr = Sheets("Récolte")
        Set Ws = Sheets("BDD")
        Wr.Unprotect
        Ws.Unprotect

    nbErreur = 0
    msgErreur = "Merci de vérifier :" & vbCrLf

    If CB_code.value = "" Then
        nbErreur = nbErreur + 1
        msgErreur = msgErreur & " - Code de la plante obligatoire" & vbCrLf
    End If

L = Sheets("Récolte").Range("a1048576").End(xlUp).Row + 1

    Range("A" & L).value = CB_code
    Range("B" & L).value = Format(LB_semis, "yyyy_mm-dd")
    Range("C" & L).value = Format(TB_Date, "yyyy-mm-dd")
    Range("E" & L).value = TB_Poids
    Range("F" & L).value = TB_Pieds
    Range("I" & L).value = TB_Capacité

lastrow2 = recolte.Range("a1048576").End(xlUp).Row
    For j = 2 To lastrow2
     If recolte.Cells(j, 2) = CB_code.value Then
         recolte.Cells("J" & j).value = Format(TB_Date2, "yyyy-mm-dd")
         recolte.Cells("L" & j).value = TB_Poids2
         recolte.Cells("M" & j).value = TB_Pieds2
         recolte.Cells("P" & j).value = TB_Capacité2
         recolte.Cells("Q" & j).value = Format(TB_Date3, "yyyy-mm-dd")
         recolte.Cells("S" & j).value = TB_Poids3
         recolte.Cells("T" & j).value = TB_Pieds3
         recolte.Cells("W" & j).value = TB_Capacité3
         End If
    Next j

    MsgBox "Plantes mises à jours, les doublons ont été effacés"

   Wr.Protect
   Ws.Protect
Unload Me
menu.Select
End If
End Sub

Private Sub CB_code_Change()
 Dim lastrow2 As Long
 Dim j As Long
 Dim i As Long
 Dim lastrow As Long

   lastrow2 = recolte.Range("a1048576").End(xlUp).Row
   For j = 2 To lastrow2

    If recolte.Cells(j, 1) = CB_code.value Then
        TB_Date = recolte.Cells(j, 3).value
        TB_Poids = recolte.Cells(j, 5).value
        TB_Pieds = recolte.Cells(j, 6).value
        TB_Capacité = recolte.Cells(j, 9).value
        TB_Date2 = recolte.Cells(j, 10).value
        TB_Poids2 = recolte.Cells(j, 12).value
        TB_Pieds2 = recolte.Cells(j, 13).value
        TB_Capacité2 = recolte.Cells(j, 16).value
        TB_Date3 = recolte.Cells(j, 17).value
        TB_Poids3 = recolte.Cells(j, 19).value
        TB_Pieds3 = recolte.Cells(j, 20).value
        TB_Capacité3 = recolte.Cells(j, 23).value
   End If
Next j

  lastrow = recap.Range("b1048576").End(xlUp).Row
  For i = 2 To lastrow

  If recap.Cells(i, 2) = CB_code.value Then
        LB_semis = recap.Cells(i, 7).value
    End If

Next i
End Sub
Le 12/07/2018 à 13:57

LouReed,

Voici une version très simplifiée du fichier initial. J'espère que vous pourrez m'aider.

Je vous remercie vivement !

14probleme-recolte.xlsm (974.56 Ko)
Le 12/07/2018 à 17:29

Bonjour Globularia,

Tu a écrit :

en revanche rien ne se passe pour Récolte, et je ne comprends pas pourquoi...

c'est tout à fait normal que rien ne se passe sur la feuille "Récolte", si t'as pas la main verte !

comme mon copain LouReeD (salut) a déjà commencé à t'aider, je le laisse faire la suite.

avec la jolie couleur verte de son pseudo, y'a toutes les chances pour qu'il te trouve une solution !

et s'il le faut, il hésitera pas à rajouter autant d'engrais qu'nécessaire !

(solution LouReeD écolo, garantie sans OGM)

dhany

Rechercher des sujets similaires à "vba remplir feuilles differentes"