Autres Recherche et copie de cellule

[theovgnl]

Bonjour, J'ai un problème de syntaxe dans ce code

Sub OLRT501CRBIS()

Worksheets("SYNTHESE").Activate

Dim NS As String, LG As Long, LC As Long, lig As Long

' nom de l'image appellante

NS = Application.Caller

'N° ligne libre feuille MVT SITE

LG = Worksheets("SYNTHESE").Range("N" & Rows.Count).End(xlUp).Row + 1

'N° ligne en cours feuille catalogue

LC = Worksheets("0LRT501CRBIS").Shapes(NS).TopLeftCell.Row 'je ne sais pas ce que c'est

'colonne D MVT_SITE = colonne E SOMMAIRE

On Error GoTo pastrouvé

lig = Sheets("SYNTHESE").Columns(2).Find(Sheets("0LRT501CRBIS").Range("B2")).Row

With Worksheets("SYNTHESE")

.Range("N" & LG).Value = Worksheets("0LRT501CRBIS").Range(LC, 3).Value

.Range("O" & LG).Value = Sheets("0LRT501CRBIS").Range("D" & lig).Value

.Range("P" & LG).Value = Sheets("0LRT501CRBIS").Range("E" & lig).Value

.Range("Q" & LG).Value = Sheets("0LRT501CRBIS").Range("F" & lig).Value

.Range("R" & LG).Value = Sheets("0LRT501CRBIS").Range("G" & lig).Value

.Range("S" & LG).Value = Sheets("0LRT501CRBIS").Range("H" & lig).Value

.Range("T" & LG).Value = Sheets("0LRT501CRBIS").Range("I" & lig).Value

.Range("W" & LG).Value = Sheets("0LRT501CRBIS").Range("J" & lig).Value

End With

Exit Sub

pastrouvé:

MsgBox ("Je ne trouve pas cette équipement")

End Sub

mon but est d'inséré les valeurs de la feuille "0LRT501CRBIS" ou d'une autre dans la lignes qui correspond au "repère coffret" dans la feuille "SYNTHESE"

 

[sylvanu]

Bonjour Théo,
J'ai beaucoup aimé :

je ne sais pas ce que c'est

😅 Ben, moi non plus.
Il semblerait que vous ayez copié une macro qui a un Shape ( dessin ou objet ) à chaque ligne. On extrait le nom de ce Shape qui est censé avoir un nom particulier pour en extraire le numéro de ligne.
Si c'est le cas il y a plus simple, ce qui évite un bouton à chaque ligne, ce qui est lourd.

Dans la PJ vous cliquez sur la ligne que vous voulez copier, et appuyez sur le bouton. J'ai mis des msgbox pour suivre le cheminement mais vous pouvez les supprimer.

Sub OLRT501CRBIS()
 Dim NS$, LC%, lig%
 LC = ActiveCell.Row ' Récupère le N° de ligne à comier
 If MsgBox("Confirmer vous vouloir copier la ligne " & LC & " ?", vbYesNo) = vbNo Then Exit Sub
 If Range("C" & LC) = "" Then Exit Sub ' car pas de chatier donc ligne considérée comme non copiable.
 On Error GoTo pastrouvé
 lig = Sheets("SYNTHESE").Columns(4).Find(Sheets("0LRT501CRBIS").Range("B2")).Row
 With Worksheets("SYNTHESE")
   .Range("N" & lig).Value = Sheets("0LRT501CRBIS").Range("C" & LC).Value
   .Range("O" & lig).Value = Sheets("0LRT501CRBIS").Range("D" & LC).Value
   .Range("P" & lig).Value = Sheets("0LRT501CRBIS").Range("E" & LC).Value
   .Range("Q" & lig).Value = Sheets("0LRT501CRBIS").Range("F" & LC).Value
   .Range("R" & lig).Value = Sheets("0LRT501CRBIS").Range("G" & LC).Value
   .Range("S" & lig).Value = Sheets("0LRT501CRBIS").Range("H" & LC).Value
   .Range("T" & lig).Value = Sheets("0LRT501CRBIS").Range("I" & LC).Value
   .Range("W" & lig).Value = Sheets("0LRT501CRBIS").Range("J" & LC).Value
 End With
 MsgBox "La ligne " & LC & " a été copiée dans la feuille Synthèse"
 Exit Sub
pastrouvé:
 MsgBox "Je ne trouve pas cette équipement"
End Sub

Evidemment je ne suis pas sur que c'est cela que vous cherchez à faire. Dans le cas contraire, mes excuses, et essayez de préciser le besoin. 🙂

 

[theovgnl]

Bonjour Théo,
J'ai beaucoup aimé :

😅 Ben, moi non plus.
Il semblerait que vous ayez copié une macro qui a un Shape ( dessin ou objet ) à chaque ligne. On extrait le nom de ce Shape qui est censé avoir un nom particulier pour en extraire le numéro de ligne.
Si c'est le cas il y a plus simple, ce qui évite un bouton à chaque ligne, ce qui est lourd.

Dans la PJ vous cliquez sur la ligne que vous voulez copier, et appuyez sur le bouton. J'ai mis des msgbox pour suivre le cheminement mais vous pouvez les supprimer.

Sub OLRT501CRBIS()
Dim NS$, LC%, lig%
LC = ActiveCell.Row ' Récupère le N° de ligne à comier
If MsgBox("Confirmer vous vouloir copier la ligne " & LC & " ?", vbYesNo) = vbNo Then Exit Sub
If Range("C" & LC) = "" Then Exit Sub ' car pas de chatier donc ligne considérée comme non copiable.
On Error GoTo pastrouvé
lig = Sheets("SYNTHESE").Columns(4).Find(Sheets("0LRT501CRBIS").Range("B2")).Row
With Worksheets("SYNTHESE")
   .Range("N" & lig).Value = Sheets("0LRT501CRBIS").Range("C" & LC).Value
   .Range("O" & lig).Value = Sheets("0LRT501CRBIS").Range("D" & LC).Value
   .Range("P" & lig).Value = Sheets("0LRT501CRBIS").Range("E" & LC).Value
   .Range("Q" & lig).Value = Sheets("0LRT501CRBIS").Range("F" & LC).Value
   .Range("R" & lig).Value = Sheets("0LRT501CRBIS").Range("G" & LC).Value
   .Range("S" & lig).Value = Sheets("0LRT501CRBIS").Range("H" & LC).Value
   .Range("T" & lig).Value = Sheets("0LRT501CRBIS").Range("I" & LC).Value
   .Range("W" & lig).Value = Sheets("0LRT501CRBIS").Range("J" & LC).Value
End With
MsgBox "La ligne " & LC & " a été copiée dans la feuille Synthèse"
Exit Sub
pastrouvé:
MsgBox "Je ne trouve pas cette équipement"
End Sub

Evidemment je ne suis pas sur que c'est cela que vous cherchez à faire. Dans le cas contraire, mes excuses, et essayez de préciser le besoin. 🙂

Merci de votre code il marche très bien j'ai aucun soucis.
Merci de votre temps et patience. Cordialement.