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!

[Marc-L]

Bonjour,

et la ligne n°12 ?!

Une autre méthode plus adaptée est d'utiliser Les filtres avancés ou élaborés dans Excel …

[mercatog]

Une première proposition (non exhaustive)

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
Private Sub CommandButton1_Click()
Dim Ws As Worksheet
Dim Thm As String
 
With Worksheets("Recherche (2)")
    Thm = .TextBox1
    If Thm <> "" Then
        For Each Ws In ThisWorkbook.Worksheets
            If Ws.Name <> .Name Then Recherche Ws, Thm
        Next Ws
    End If
End With
End Sub
 
Private Sub Recherche(ByVal Ws As Worksheet, ByVal Theme As String)
Dim NumPv As String
Dim NewLig As Long
Dim c As Range
 
Set c = Ws.Range("B:B").Find(Theme, LookIn:=xlValues, Lookat:=xlPart)
If Not c Is Nothing Then
    NumPv = Ws.Range("A1")
    With Worksheets("Recherche (2)")
        NewLig = Application.Max(18, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
        .Range("A" & NewLig).Resize(, 3) = Array(NumPv, c, c.Offset(, 1))
    End With
    Set c = Nothing
End If
End Sub

[sharivary]

Merci!

ça marche nickel !

J'avoue ne pas avoir compris mon erreur initiale mais merci à vous deux!

Bonne journée!