Macro recherche+copier coller

Bonjour,
Dans le cadre de l'optimisation d'une BDD "clients", je dois éviter que les utilisateurs complètent directement la bdd. Donc j'ai crée un formulaire sur la feuille 2, ou ils peuvent remplir la fiche, puis via un bouton, la macro part coller les infos dans la BDD feuille 1
Le truc, c'est qu'il faut pas qu'il y ai de doublons. De la même façon on doit pouvoir modifier une fiche sans toucher la BDD.

Ainsi je cherche à exécuter une macro de recherche copier/coller à l'appui d'un bouton depuis la feuille 2.
Cette macro irait chercher dans les colonnes C et D de la feuille 1 le "nom" et prénom de la personne (à voir pour la casse) en question, puis irait copier coller la ligne entière (si trouvée) dans la feuille 3.
Si la macro trouve plusieurs occurrences (peu probable), elle devra aller copier coller les lignes dans la feuille 3 à la suite. Depuis la feuille 3 on pourra voir si l'entrée existe déjà. Auquel cas, on pourra la modifier ( sans le formulaire du coup), puis un autre bouton (en face de la ligne) irait coller la modif dans la feuille 1 puis effacerait la ligne de la feuille 3 ( voire toutes les lignes)

Voilà j'ai réussi à créer le formulaire de création et la macro, l'inputbox de recherche dans la feuille 2 par appui de bouton, la macro va bien dans la feuille 1, mais après je sèche....J'ai essayé divers trucs mais ca plante...C'est peut etre trop ambitieux...

Bonjour,

plus simple ça sera de mettre dans ta feuille 2 une mise en forme conditionnelle (suite a ta saisie si la couleur change c'est qu'il existe sinon il n'existe pas), après a l'aide d'enregistreur de macro tu rajoutera le commandbutton pour copier coller directement dans ta feuille 1.

Cordialement

Gestionnaire rh

Bonjour,

votre projet n'est pas "trop ambitieux". Mais lorsque vous écrivez "ça plante...", c'est un peu flou pour que l'on puisse vous aider.
- Qu'est-ce qui plante ?
- Pouvez vous déboguer en mode pas à pas, et localiser l'instruction qui plante ?

bonjour,

Je suis un débutant, mais j'ai utilisé cette sub à l'intérieur de mon programme pour récupérer les données :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34

Sub selectligne()   question = "" recherche = "" recherchosr = ""   question = MsgBox("Avez vous sélectionner une cases de la ligne du dossier a relancé", vbYesNo, "SELECTION LIGNE") If question = 6 Then   numero = "" numero = ActiveCell.Row   End If   If question = 7 Then   Sheets("SUIVI").Activate recherche = MsgBox("Voulez vous recherchez par le n° OSR", vbYesNo, "SELECTION LIGNE") If recherche = 6 Then ActiveSheet.Unprotect recherchosr = InputBox("Veuillez saisir le n° OSR !", "SELECTION LIGNE") ActiveSheet.Range("$A$5").AutoFilter Field:=1 ActiveSheet.Range("$A$5").AutoFilter Field:=1, Criteria1:=recherchosr MsgBox "Veuillez sélectionner une case de la ligne concernée par la relance" & Chr(10) & "et cliquez à nouveau sur le bouton RELANCE ", vbInformation, "RELANCE" ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End End If If recherche = 7 Then MsgBox "Veuillez sélectionner une case de la ligne concernée par la relance" & Chr(10) & "et cliquez à nouveau sur le bouton RELANCE", vbInformation, "RELANCE" End End If End If   End Sub

---

Cette sub s'utilise feuille protégé et demande de sélectionnez un case de la ligne pour pouvoir déterminer quels seront les données à modifier.
Dans le cas où la liste serait trop longue elle propose de filtrer sur une colonne appelé OSR.

Une fois cette ligne déterminer il te suffit de faire appel à la variable numero pour qui contient le numéro de ligne.

Il faut avant sub faire ceci :

dim numero as string

pour qu'elle soit utilisable dans plusieurs sub du même module.

Après les experts pouront t'aider.

en espérant vous avoir aider

Voici mon code de recherche.
La macro trouve le mot clé et retourne "suite de la macro" sinon "rien trouvé".
cette partie fonctionne ( bien qu'il mette "rien trouvé" après qu'il est trouvé le mot.

Maintenant, il faut que cette macro aille copier coller la ligne ou le mot a été trouvé dans une autre feuille. Si un autre mot est trouvé ailleurs dans la colonne, faut qu'elle aille copier également la ligne dans l'autre feuille, à la suite de la première.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

Dim i As Integer Sheets("BDD").Select Range("C65536").End(xlUp).Select maxfor = Range("C65536").End(xlUp).Row If Not TextBox1.Value = "" Then   For i = 8 To maxfor If Cells(i, 3).Value = TextBox1.Value Then MsgBox "suite de la macro", vbExclamation + vbOKOnly, "" TextBox1.SetFocus End If Next i   Else MsgBox "Tapez un nom", vbExclamation + vbOKOnly, "" TextBox1.SetFocus End If MsgBox "rien trouvé", vbExclamation + vbOKOnly, ""

---

Bon j'ai progressé. La macro va bien chercher, retourne toutes les occurences et les copie a la suite.
Reste à faire: ajouter des boutons "modif" en face de chaque ligne et un bouton "efface" si on a rien a modifier par exemple qui efface les lignes.
A l'appui de "modif", ca part coller la modif ou il faut dans la bdd, puis elle retourne effacer la ligne de la page "modifs".

Voilà si vous voyez comment faire (parce que j'ai passé ma journée à faire ca) ou si vous voulez optimiser pour réduire le code...

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49

Private Sub CommandButton1_Click()   Dim i As Integer   If Not TextBox1.Value = "" Then Sheets("BDD").Select Range("C65536").End(xlUp).Select maxfor = Range("C65536").End(xlUp).Row Z = 0 i = 8 x = 0   If Cells(i, 3).Value = TextBox1.Value Then Range("C" & i & ":M" & i).Select Selection.Copy Sheets("colle").Select   Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True End If Do Until i = maxfor i = i + 1 x = x + 1 If Cells(i, 3).Value = TextBox1.Value Then Range("C" & i & ":M" & i).Select Selection.Copy Sheets("colle").Select Range("C" & x).Select   Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("BDD").Select End If   Loop       Else MsgBox "Tapez un nom", vbExclamation + vbOKOnly, "" TextBox1.SetFocus x = 1 End If If x = 0 Then MsgBox "Rien trouvé", vbExclamation + vbOKOnly, "" End If   End Sub

---