Discussion :

[ll30ll30]

Bonjour à tous,

Je débute en VBA et suis encore très très nul, voire ignare !
Quelqu'un peut il m'écrire cette macro ?

Dans ma "Feuil1", je cherche le mot "TOTO" quelque part en "Col 1".
Une fois trouvé ce mot,
Sauter 2 lignes,
Copier à partir de la suivante, les 20 lignes qui suivent de la "Col 3 à Col 10".
Ouvrir la Feuil2
Effacer toutes les données ultérieures
Coller à partir de Ligne 30, Col2 (les infos récoltés, avec mise en forme)

Voilou

Si une âme charitable et compétente peut m'aider

Merci d'avance

LL30

[QuestVba]

Bonjour,

Ce serait bien d'avoir un fichier avec les données (non perso) et un petit début. Il existe un enregistreur de macro, .... Montre et on voit après

[ll30ll30]

Ma sono incompetant

Voila ce que j'ai écrit, mais je ne sais pas lui faire sélectionner les bonnes lignes

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
Sub CopierOK()
'
' Macro6 Macro
' Macro enregistrée le 21/01/2013 par LL
'
Mot = "TOTO"
Columns(ActiveCell.Column).Select
Set c = Selection.Find(Mot, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
premier = c.Address
Do
Rows(c.Row).Copy Sheets(2).[a65000].End(xlUp).Offset(1, 0)
Set c = Selection.FindNext(c)
Loop While Not c Is Nothing And c.Address <> premier
Sheets(2).Select
Range("A2").Select
End If
End Sub

Ce que je veux :
Dans ma "Feuil1", je cherche le mot "TOTO" quelque part en "Col 1".
Une fois trouvé ce mot,
""Jusque la ça va mais après je ne sais pas""

Sauter 2 lignes,
Copier à partir de la suivante, les 20 lignes qui suivent de la "Col 3 à Col 10".
Ouvrir la Feuil2
Effacer toutes les données ultérieures
Coller à partir de Ligne 30, Col2 (les infos récoltés, avec mise en forme)

[AlainTech]

Bonjour,

Très bel effort, déjà.

Tu liras très souvent sur ce forum qu'il faut éviter les Select, Active et Selection.

J'ai un peu remanié ton code pour la robustesse et la clarté.

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
Option Explicit
 
Sub CopierOK()
'
' Macro6 Macro
' Macro enregistrée le 21/01/2013 par LL
'
  Dim c As Range
  Dim Mot As String
  Dim premier As String
  Dim rSource As Range
  Dim wksSource As Worksheet
 
  Mot = "TOTO"
  Set wksSource = ThisWorkbook.Sheets(1) ' A adapter. A la place de 1, tu peux mettre le nom de la feuille entre guillemets
  Set rSource = Range(wksSource.Cells(1, 1), wksSource.Cells(wksSource.Rows.Count, 1).End(xlUp))
  Set c = rSource.Find(Mot, LookIn:=xlValues, LookAt:=xlWhole)
  If Not c Is Nothing Then
    premier = c.Address
    Do
      c.EntireRow.Copy Sheets(2).Cells(Sheets(2).Rows.count,1).End(xlUp).Offset(1, 0)
      Set c = rSource.FindNext(c)
    Loop While Not c Is Nothing And c.Address <> premier
    Sheets(2).Select
    Range("A2").Select
  End If
End Sub

Pour la suite, désolé je n'ai pas compris.
Un petit exemple de données pseudo réelles (sans données confidentielles) et du résultat attendu serait le bienvenu.

[ll30ll30]

Après avoir Identifié "TOTO" je veux :

Sauter 2 ligne après TOTO
Copier les 20 lignes suivantes de la Col 3 à la Col 10
Nettoyer sur la Feuil2 les Cell (A5:K50) y compris images et objets ...
Coller sur la Feuil2 à partir de la Ligne 30 Col 2, ce qui a été copier en Feuil1

Voila

J'espère que tu comprendra

Merci

Laurent

[ll30ll30]

Merci à tous pour votre aide. Mon pb est résolu.
J'ai trouvé la solution sur "Excel Pratique" par Frangy.

Si ça peut aider quelqu'un :

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
    Sub Test()
    Dim C As Range
        With Worksheets("Feuil2")
            'Dans ma "Feuil1", je cherche le mot "TOTO" quelque part en "Col 1".
           Set C = Worksheets("Feuil1").Columns("A:A").Find("TOTO", LookIn:=xlValues, LookAt:=xlPart)
            'Une fois trouvé ce mot
           If Not C Is Nothing Then
                'Effacer toutes les données ultérieures dans la Feuil2
               .Cells(30, 2).Resize(20, 8).Clear
                'Copier à partir de la 3eme ligne suivante, les 20 lignes qui suivent de la "Col 3 à Col 10".
               'Coller en feuille 2, à partir de la ligne 30, Colonne 2 les infos récoltés, avec mise en forme)
               C.Offset(3, 2).Resize(20, 8).Copy .Cells(30, 2)
                Application.CutCopyMode = False
            End If
        End With
    End Sub

Merci encore

A+

Laurent