[XL-2003] Macro recherche+copier coller

[nico77ssx]

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...

[Gestionnaire_rh]

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

[rtg57]

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 ?

[chrisaccess]

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

[nico77ssx]

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, ""

[nico77ssx]

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