Discussion :

[jeje5969]

Bonjour,

Voila ce que je souhaite faire.
J'ai une feuille "import donnée" ds laquelle j'ai concaténé plusieurs fichier. Dans ce fichier apparait dans la colonne B a plusieurs reprises le mot "Consommation" et dessous des valeurs dont j'ai besoin de copier ( et ceux a plusieurs reprises, les fichiers etant superposés)
Je veux via VBA faire une recherche de ce mot, puis qd il l;'a trouvé se décale de 3 lignes et 0 colonnes
la je selectionne et copie ce qui m'interesse dans une autre feuille.
Puis je reviens dans ma feuille import donnée relance la recherche du mot consommation et recommence.
cette boucle dois durer 10 fois.

Mon Pb quand je fais cette recherche il repart du haut du tableau.
Merci pour votre aide.
J’espère être clair

[mercatog]

Bonjour
Regarde l'aide sur la méhode Find de l'objet Range. Tu as un exemple d'utilisation sur toutes les occurrences.

Code :

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

1
2
3
4
5
6
7
8
9
10
With Worksheets(1).Range("a1:a500") 'A adapter
    Set c = .Find(2, lookin:=xlValues) 
    If Not c Is Nothing Then 
        firstAddress = c.Address 
        Do 
            c.Value = 5 'A adapter
            Set c = .FindNext(c) 
        Loop While Not c Is Nothing And c.Address<> firstAddress
    End If 
End With

Tu remplaceras la ligne c.Value=5 par c.offset(3).copy...

[jeje5969]

Ok déjà merci , cela m'a bien aidé.
Maintenant comment faut-il que je fasse pour que le copier coller se fasse à la suite de ce qui a déjà été copié et n'écrase pas la première copie ?

voila ma macro

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
Sub test()
 
With Sheets(2).Range("B1:b1800") 'A adapter
    Set c = .Find(what:="Consommation")
    If Not c Is Nothing Then
        firstAddress = c.Address
 
        Do
            Range(c.Offset(3, 0), c.Offset(3, 1)).Select
            Range(Selection, Selection.End(xlDown)).Copy Sheets(3).Cells(2, 1) 'c.Value = Essai
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
End Sub

merci

[MarcelG]

Bonjour,

Hé à toi ô grand mercatog (Il y a du "Seigneur des Anneaux" dans ce nom là! ). J'espère que tu vas bien.

Pour répondre à la question de notre ami.
Rechercher après chaque copie la dernière cellule informée décalée d'une ligne.
Pour une plus grande souplesse d'écriture, personnellement, j'utiliserais une fonction retournant cette cellule.

Je viens de tester

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
Option Explicit
 
Public Sub rp_chaine()
 
Dim i As Long
 
With Worksheets("lawks")
 
For i = 1 To 10
        destcel("lawks", 1).Value = 1
Next i
 
End With
 
End Sub
 
Public Function destcel(nomfeuille As String, numcolonne As Integer) As Range
 
With Worksheets(nomfeuille)
    Set destcel = .Cells(.Rows.Count, numcolonne).End(xlUp).Offset(1, 0)
End With
 
 
End Function

(à adapter bien entendu)

Dans le cas ici exposé, destcel serait la cellule de destination.

[mercatog]

Bonjour Cher Marcel,
Merci pour tout. Voilà, ça peut rouler. Et vous? c'est désormais l'Italie!

Pour compléter, sur la base du code de jeje

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
Sub Test()
Dim FirstAddress As String
Dim c As Range
 
With Sheets(2)
    Set c = .Range("B:B").Find(what:="Consommation", LookIn:=xlValues, lookat:=xlPart)    'Regarde les arguments de la méthode find
    If Not c Is Nothing Then
        FirstAddress = c.Address
        Do
            .Range(c.Offset(3, 1), c.Offset(3, 0).End(xlDown)).Copy Sheets(3).Cells(Rows.Count, 1).End(xlUp)(2)
            Set c = .Range("B:B").FindNext(c)
        Loop While Not c Is Nothing And c.Address <> FirstAddress
    End If
End With
End Sub

[jeje5969]

Merci
a vous 2, je vais tester.
Tres sympa de m'avoir repondu aussi rapidement