VBA besoin d'aide svp

Version imprimable

bonjour le forum ,
J'ai besoin de votre aide ,pour un pgm VBA que je suis en train de faire .

Explication du fichier et du besoin :
J'ai une collection de données (ligne et colonne aléatoire), dans la plage de données commençant de G3 a X et Y, j'ai besoin de trouver le mot "Recomptage" dans cette plage (Jusque la je pense que c'est bon)
Une fois ce mot trouvé je voudrais récupérer les données contenues dans la ligne du mot trouve en col Ax a Gx et la valeur du titre , et les coller sur un autre onglet
Ce que j'ai essayer de faire :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub test() Dim PlageTravail As Range, cell As Range Set ws = Sheets("CTRL comptage 1") NumLign = Range("G" & Rows.Count).End(xlUp).Row + 1 'n° de la première ligne vide de la colonne A NumCol = Cells(3, Columns.Count).End(xlToLeft).Column 'n° de la dernière colonne non vide de la ligne 1 Set PlageTravail = ws.Range(ws.Cells(3, 7), ws.Cells(NumLign, NumCol)) For Each cell In PlageTravail If cell.Value = "Recomptage" Then MsgBox cell.Value cell.Select End If Next cell End Sub
Exemple concret :
Imaginons que je trouve le mot en cellule AK8 , je veux récupérer les valeur de A8 a G8 et AK3 .
Et copier ces valeur dans un autre onglet ou incrémenter une array .
Merci pour votre aide précieuse .

Proposition utilisant la méthode Find

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
Sub test()
Dim PlageTravail As Range, c As Range
Dim NumCol As Integer
Dim NumLign As Long
Dim Prem As String
 
Application.ScreenUpdating = False
With Worksheets("CTRL comptage 1")
    NumLign = .Range("G" & .Rows.Count).End(xlUp).Row
    NumCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
    Set PlageTravail = .Range(.Cells(3, 7), .Cells(NumLign, NumCol))
End With
 
With PlageTravail
    Set c = .Find("Recomptage", LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        Prem = c.Address
        Do
            Envoi c
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Prem
    End If
End With
Set PlageTravail = Nothing
End Sub
 
Private Sub Envoi(ByVal v As Range)
 
With Worksheets("Destination")    'à adpter
    With .Cells(.Rows.Count, 1).End(xlUp)(2)
        .Resize(, 7).Value = v.Offset(, 1 - v.Column).Resize(, 7).Value
        .Offset(, 7).Value = v.Offset(3 - v.Row).Value
    End With
End With
End Sub

28/03/2016, 11h09
didoch54000

Merci Mercatog pour avoir pris le temps de me répondre à 00H45...
Ton bout de code fonctionne à la perfection , j'ai adapté a mes besoins mais cela correspond .
Un grand Merci donc je clos le sujet.