Peut on m'écrire une Macro - XL2003-2007

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

Bonjour,

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:=xlValue, 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

Bon courage!

A+

Merci beaucoup pour ton aide, surtout que tu es le seul apparemment à maitriser le sujet !

Mais j'ai "Erreur d'exécution 9" l'indice n'appartient pas à la sélection.

Set C = Worksheets("Feuil1").Columns("A:A").Find("TOTO", LookIn:=xlValue, LookAt:=xlPart)

Voila ???

Merci

Bonjour,

Pas glop !

Set C = Worksheets("Feuil1").Columns("A:A").Find("TOTO", LookIn:=xlValues, LookAt:=xlPart)

A+

Yessss, merrrkki, ça fonctionne

Vraiment merci Beaucoup

Au plaisir

Laurent

Encore merci à frangy

J'ai une petite demande complémentaire.

Je souhaiterais quand je demande de sélectionner les 20 lignes suivante,

qu'il s'arrête si il trouve une ligne vierge.

Cad : Dans les 20 lignes si après la 15 ème il y a une ligne vierge, tu t'arrête et ne copie que les 15.

Voilou

A+

Laurent

Bonjour,

Voila, voila ...

    Sub Test()
    Dim C As Range
    Dim DerLig As Long, NbLigne As Long
        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
                'Recherche de la dernière ligne renseignée de la plage à copier
                DerLig = C.Offset(3, 2).CurrentRegion.End(xlDown).Row
                'Calcul du nombre de lignes à copier
                NbLigne = DerLig - C.Offset(3, 2).Row + 1
                If NbLigne >= 20 Then NbLigne = 20
                '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(NbLigne, 8).Copy .Cells(30, 2)
                Application.CutCopyMode = False
            End If
            Set C = Nothing
        End With
    End Sub

A+

Trop fort "frangy"

Si tu as encore un petit peu de temps pour moi ...

au lieu qu'il s'arrête quand il trouve une ligne vierge,

qu'il s'arrête de copier quand il rencontre (dans ces fameuses 20 lignes) Col1, le mot "TATA"

Voili Voilou

Et encore un très grand merci à toi

A+

Laurent

Re,re, re bonjour

Heu ! ... Es-tu certain de savoir ce que veux faire ?

Une question en appelle une autre ... J’ai l’impression de jouer aux poupées russes.

Ma période de doute étant passée, voici la benjamine

Sub Test()
    Dim C As Range, D As Range, MaPlage As Range
    Dim NbLigne As Long
        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
                'On définit la plage à copier
                Set MaPlage = C.Offset(3, 2).Resize(20, 8)
                'On recherche le mot "Tata" dans la colonne 1 de la plage
                Set D = MaPlage.Columns(1).Find("TATA", LookIn:=xlValues, LookAt:=xlPart)
                If Not D Is Nothing Then
                    'Calcul du nombre de lignes à copier
                    NbLigne = D.Row - C.Offset(3, 2).Row + 1
                Else
                    NbLigne = 20
                End If
                'Effacer toutes les données ultérieures dans la Feuil2
               .Cells(30, 2).Resize(20, 8).Clear
                'Copier la plage et Coller en feuille 2, à partir de la ligne 30, Colonne 2
               C.Offset(3, 2).Resize(NbLigne, 8).Copy .Cells(30, 2)
                Application.CutCopyMode = False
            End If
            Set C = Nothing: Set D = Nothing: Set MaPlage = Nothing
        End With
End Sub

A+

C'est parfait merci,

Oui je sais ce que je veux, ça me sert juste à comprendre et à apprendre afin de voler au mieux de mes propres ailes.

Merci encore

Cordialement

Laurent