Discussion :

[sharivary]

Bonjour,

Je débute en VBA et je souhaiterais réaliser une feuille de recherche.

Un classeur avec des compte rendu hebdomadaire de réunion (chaque compte rendu sur une feuille)

La démarche est la suivante :

- Effectué une recherche par mot clé sur la colonne "THEME" en "B"
- Copier les cellules contenant la date du compte rendu et les coller sur la première ligne vide de la feuille "recherche(2)" à partir de la ligne 18
- Retrouver la cellule de la valeur de référence recherché initialement et selectionner cette dernière ainsi que les 6 cellules sur la droite et les copier
- Les coller sur la première ligne vide de la feuille "recherche(2)" à partir de la ligne 18
- Passer à la feuille de compte rendu suivante et re belote

Après pas mal de recherche je coince sur la sélection de la cellule contenant la valeur recherché.


Le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Private Sub CommandButton1_Click()
Dim c As Range
Dim n As Integer
If TextBox1 = "" Then Exit Sub
For n = 1 To Sheets.Count
If Sheets(n).Name <> "Feuil1" Then
Sheets(n).Select
With ActiveSheet.Range("B1:B" & ActiveSheet.Range("B65536").End(xlUp).Row)
 Set c = .find(TextBox1.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
    c.Select
 
        ActiveSheet.Range("A1:H1").Copy
        Sheets("Recherche (2)").Select
            If Range("A18").Value = "" Then
            Range("A18").Select
            Else
                If Range("A18").Value <> "" And Range("A19").Value = "" Then
                Range("A18").Select
                    Else
                    Range("A18").End(xlDown).Offset(1, 0).Select
                End If
            End If
            ActiveSheet.Paste
 
 
 
 
c(ActiveCell, ActiveCell.Offset(0, 6)).Copy
  If Range("A18").Value = "" Then
            Range("A18").Select
            Else
                If Range("A18").Value <> "" And Range("A19").Value = "" Then
                Range("A18").Select
                    Else
                    Range("A18").End(xlDown).Offset(1, 0).Select
                End If
            End If
            ActiveSheet.Paste
End If
End With
End If
Next n
Sheets(1).Select
MsgBox ("Ce code n'existe pas")
Application.ScreenUpdating = True
End Sub

Merci d'avance à vous pour les connaissance déjà apportées!