[VBA-E]Macro pour positionnement cellule

Bonjour,
J'ai un tableau sur Excel pour gérer un stock et pour faciliter la recherche du N° d'artiche, lors de l'encodage, il faudrait une petite macro qui en indiquant le N° de l'article dans la cellule "J2" et poussant sur un bouton de macro,le curseur se place directement sur le N° de l'article.
S'il n'existe pas encore se positionner sur la 1ère cellule vide dans la colonne "A".
ps: les n° d'article se trouvent en colonne A

Merçi à vous pour votre aide.
Bonne soirée :D

Bonjour,

Ci dessous proposition:

Code:

---

1 2 3 4 5 6 7

If ActiveCell.Address <> "$J$1" Then: Exit Sub code = Range("J1") On Error Resume Next Columns(1).Find(code).Select If Error > 0 Then Cells(Range("A65536").End(xlUp).Row + 1, 1).Select End If

---

On pourrait améliorer avec une macro événementielle: tu tapes ton code en J1 et quand tu valides... hop sur la cellule

A+
Michel_M

Salut Michel_M j'ai essayé la vba et elle ne fonctionne pas. Il faudrait que quand j'ai encodé le n°art (ex:159) et en valident, elle se rende automatiquement sur la cellule avec l'article (ex:159).
Mais si l'article n'a pas encore été encodé dans le stock, il doit aller à la première ligne libre pour l'introduire et cela ça marche
Merç!

Bonjour Micky

en réponse petite démo dans ce lien
http://www.cijoint.fr/cij64039718611330.xls

en espérant que...

Michel_M

Bonjour Michel_M, merçi de suivre mon petit problème.
Ok pour la démo, mais ou est la vba? car celle que tu m'as faite ne se rend pas sur l'article indiqué en "J1"
:king:

Salut Micky
je pense que le problème est celui-ci
la macro de Michel plante parce que la cible est J1 mais une fois validé le changement c'est J2 qui est active (ou la case qui est reprise par défaut après validation)
j'ai modifié la macro comme suit:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Private Sub Worksheet_Change(ByVal Target As Range) Dim code As Variant If ActiveCell <> Cells(2, 10) Then Exit Sub Else code = Range("j1").Value On Error Resume Next Columns(1).Find(code).Select If Err.Number > 0 Then Cells(Range("A65536").End(xlUp).Row + 1, 1).Select End If End If End Sub

---

je ne me rappelle plus comment cibler une seule cellule en changement
attention toutefois la macros telle qu'elle est te pointera le 12 sur le 123 si il se trouve avant le douze
lorsque je te demandais quel est le problème je voulait le titre du fil
Daranc

J'ai essayé mais je n'arrive pas donc:
Voilà le fichier dont je souhaite réaliser la vba.
Merçi

Stock.rar

Re,

j'ai re-essayé ma macro, elle marche sauf sur la remarque de Daranc (merci) concernant la valeur 12: j'ai donc paramétré la fonction "find" avec xlwhole et c'est OK

Sur ma machine, l'option de déplacement après validation est toujours supprimée (j'ai toujiours considéré que ce déplacement était parasite)de toutes façons déplacement ou non la valeur de J2 ne rentre pas en ligne de compte puisque le code est saisi en J1....

voici le code

Code:

---

1 2 3 4 5 6 7 8 9 10

Private Sub Worksheet_Change(ByVal Target As Range)   If ActiveCell.Address <> "$J$1" Then: Exit Sub   On Error Resume Next Columns(1).Find(Target, , , xlWhole).Select If Err.Number > 0 Then Cells(Range("A65536").End(xlUp).Row + 1, 1).Select End If End Sub

---

Cette macro se trouve dans le module feuil1 suite à la demande de Micky d'aller sur le code après validation (macro événementielle)

Bon aprem

Michel

Salut Michel_M, j'ai mis le fichier "Stock.rar" pour que tu essayes la vba. Ce qu'il faut surtout c'est que si le N° d'art. n'est pas encore encodé, que la valeur de "J2" s'écrive sur la 1ère cellule libre dans la colonne "A".
Merci à vous de votre aide. Bonne aprem :king:

Stock.rar

Re,

désolé, mais je n'ai pas de dézippeur .rar

ajoute cette ligne

Code:

---

1 2 3 4

Cells(Range("A65536").End(xlUp).Row + 1, 1).Select activecell=range("J1").value End If

---

Au départ tu me parlais de J1, maintenant c'est J2 et moi je ne pige plus.
peut être je répète: lle fait de décaler après validation est parasite; outils -options- modifications et tu décoches déplacer après validation

Michel

Toutes mes excuses, j'ai corrigé ma faute sur le 1er message.
Bonne soirée :D

Merci à tous ceux qui m'ont aidé à solutionner mon problème de vba sur Excel.
Bonne soirée :king::king::king:

Re Micky58,

Content que vous soyez satisfait du code.

A toutes fins utiles c'est celui-ci :

Citation:

---

Sub Rech_art()
Dim pl As Long
Dim art1, art2 As Variant

Sheets("Stoks").Activate

art1 = Cells(2, 10)
pl = 5

Cherch:
art2 = Cells(pl, 1)
If IsEmpty(art2) Then
MsgBox "Article " & art1 & " non trouvé. Il a été ajouté en fin de fichier."
Range(Cells(pl, 1), Cells(pl, 1)).Select
Rows(pl).Select
Selection.Insert Shift:=xlDown
Cells(pl, 1) = art1
Exit Sub
Else
If art2 = art1 Then
Range(Cells(pl, 1), Cells(pl, 1)).Select
Exit Sub
Else
If art2 > art1 Then
Rows(pl).Select
Selection.Insert Shift:=xlDown
Cells(pl, 1) = art1
MsgBox "Article " & art1 & " non trouvé. Il a été ajouté entre 2 articles existants."
Range(Cells(pl, 1), Cells(pl, 1)).Select
Exit Sub
End If
pl = pl + 1
GoTo Cherch
End If
End If

---

End Sub

Amicalement.

Ok merci Jacques_Jean, j'attends la dernière version avec l'insertion de ligne formules comprises.
Bonne journée @+

Citation:

---

Envoyé par Michel_M

désolé, mais je n'ai pas de dézippeur .rar

---

Izarc y dezip tout:king:
Daranc

Bonjour Micky58,

Citation:

---

Sub Rech_art()
Dim pl As Long
Dim art1, art2 As Variant

Sheets("Stoks").Activate

art1 = Cells(2, 10)
pl = 5

Cherch:
art2 = Cells(pl, 1)
If IsEmpty(art2) Then
MsgBox "Article " & art1 & " non trouvé. Il a été ajouté en fin de fichier."
'Range(Cells(pl, 1), Cells(pl, 1)).Select
Rows(pl).Select
Selection.RowHeight = 17
Range(Cells(pl - 1, 1), Cells(pl - 1, 6)).Select
Selection.Copy
Range(Cells(pl, 1), Cells(pl, 1)).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
Cells(pl, 1) = art1
Cells(pl, 3) = ""
Cells(pl, 4) = ""
Cells(pl, 6) = ""
Exit Sub
Else
If art2 = art1 Then
Range(Cells(pl, 1), Cells(pl, 1)).Select
Exit Sub
Else
If art2 > art1 Then
Rows(pl).Select
Selection.Insert Shift:=xlDown
Selection.RowHeight = 17
Range(Cells(pl - 1, 1), Cells(pl - 1, 5)).Select
Selection.Copy
Range(Cells(pl, 1), Cells(pl, 1)).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
Cells(pl, 1) = art1
Cells(pl, 3) = ""
Cells(pl, 4) = ""
Cells(pl, 6) = ""
MsgBox "Article " & art1 & " non trouvé. Il a été ajouté entre 2 articles existants."
Range(Cells(pl, 1), Cells(pl, 1)).Select
Exit Sub
End If
pl = pl + 1
GoTo Cherch
End If
End If

End Sub

---

Les formules et le format sont copiés.
Bonne journée.
Amicalement.

Bonjour Jacques_jean,
vba bien reçue et elle fonctionne à merveille. Félicitation pour ton exellent travail et je te REMERCIE pour tout. :king::king::king:
Bonne journée et à bientôt sur ce merveilleux forum :yaisse2: