Fiche de suivis de consomation EPI

Question

Bonjour, j'ai essayer en ayant 0 connaisiance à faire un code VBA pour permettre à des opérateur de saisir des quantités dans des ongles car tout le reste je l'es automatisé avec des liste de tout les opérateur.
J'ai fais ce code la pour une de mes feuille BBSdiv ( c'est le nom d'un des secteur) :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim BBSDiv, Equipe, Liste, Minérale As Worksheet
Set fEquipe = Worksheets("Equipe")
Set fBBSDiv = Worksheets("BBSDiv")
Set fListe = Worksheets("Liste")
Dim reponse As Variant

If Not Intersect(Target, Range("E4")) Is Nothing Then
fBBSDiv.Range("B7:K20").ClearContents
Cancel = True

End If

If Not Intersect(Target, Range("B4")) Is Nothing Then
If Range("B4") = "" Then
MsgBox "Merci de selectionner un Opérateur", vbCritical
Else
Dim nextligne, ligneCombinaison As Long
nextligne = fBBSDiv.Range("B" & Rows.Count).End(xlUp).Row + 1
ligneCombinaison = fEquipe.Range("A3:A5").Find(fBBSDiv.Range("B4"), _
LookIn:=xlValues).Row
fEquipe.Range("B" & ligneCombinaison).Copy
fBBSDiv.Range("B" & nextligne).PasteSpecial xlPasteValues
fListe.Range("B" & nextligne).PasteSpecial xlPasteValues
fEquipe.Range("C" & ligneCombinaison).Copy
fBBSDiv.Range("D" & nextligne).PasteSpecial xlPasteValues
fEquipe.Range("D" & ligneCombinaison).Copy
fBBSDiv.Range("F" & nextligne).PasteSpecial xlPasteValues
fEquipe.Range("E" & ligneCombinaison).Copy
fBBSDiv.Range("H" & nextligne).PasteSpecial xlPasteValues
fEquipe.Range("F" & ligneCombinaison).Copy
fBBSDiv.Range("J" & nextligne).PasteSpecial xlPasteValues
Dim col As Integer
For col = 4 To 10
fBBSDiv.Cells(nextligne, col).Copy
fListe.Cells(nextligne, col).PasteSpecial xlPasteValues
Next col
fBBSDiv.Range("B4").ClearContents
Cancel = True

reponse = InputBox("Combien voulez-vous en commander?", _
"Combinaison")
If reponse = "" Or reponse = 0 Then
MsgBox "Merci de saisir une quantité non nulle"
Else
fBBSDiv.Range("C" & nextligne) = reponse
fListe.Range("C" & nextligne) = reponse
End If
reponse = InputBox("Combien voulez-vous en commander?", _
"Gant Acide")
If reponse = "" Or reponse = 0 Then
MsgBox "Merci de saisir une quantité non nulle"
Else
fBBSDiv.Range("E" & nextligne) = reponse
fListe.Range("E" & nextligne) = reponse
End If
reponse = InputBox("Combien voulez-vous en commander?", _
"Gant manutention")
If reponse = "" Or reponse = 0 Then
MsgBox "Merci de saisir une quantité non nulle"
Else
fBBSDiv.Range("G" & nextligne) = reponse
fListe.Range("G" & nextligne) = reponse
End If
reponse = InputBox("Combien voulez-vous en commander?", _
"Botte")
If reponse = "" Then
Else
fBBSDiv.Range("I" & nextligne) = reponse
fListe.Range("I" & nextligne) = reponse
End If
reponse = InputBox("Combien voulez-vous en commander?", _
"Chaussure sécurité")
If reponse = "" Then
Else
fBBSDiv.Range("K" & nextligne) = reponse
fListe.Range("K" & nextligne) = reponse

End If
End If
End If

Dim targetColumn As String
Dim targetStartCell As Range
Dim lastRow As Long
Dim currentRow As Long

' Définir la colonne et la cellule de départ cible
targetColumn = "L"
Set targetStartCell = fListe.Range("L7")

' Initialiser currentRow à la ligne de départ
currentRow = targetStartCell.Row

' Boucler à partir de la ligne de départ jusqu'à trouver la prochaine cellule vide
Do While Not IsEmpty(fListe.Cells(currentRow, targetColumn).Value)
currentRow = currentRow + 1
Loop

' Copier le nom de la feuille source dans la colonne cible
fListe.Cells(currentRow, targetColumn).Value = fBBSDiv.Name

Me.AutoFilter.ApplyFilter
End Sub

Ensuite j'ai repris le meme code pour un autre secteur dans une autre feuille en faisant attention à changer le nom de feuille dans mon script. sauf que quand je lance le script de la feuille BBSDiv mes odnnées sont bien copier coller dans la feuille Liste mais des lorsque je lance le meme scrip mais cette fois dans ma feuille Minérale par exemple. Bha mes données d'avant de la feuille BBSDiv quise trouver dans la feuille liste sont ecrasé par les données du script de la feuille Minérale

Joco7915 · Answer

Un exemple anonymisé de ton fichier serait bien utile pour trouver la solution CRDLT...