VBA copier des lignes précises entre un interval choisi

Bonjour à tous,

J'ai plusieurs fichiers excel A B C D etc ou je vais devoir copier des lignes entre deux mots spécifiques puis coller ces lignes en dessous des autres dans un fichier excel A'.

J'ai commencé à faire une boucle car je dois répeter la même action pour les fichiers A B C D etc.

ci dessous mon code. mais il me manque la partie ou je dois isoler les lignes que je souhaite copier entre deux mots spécifiques.

Sur la colonne A, j'ai un mot que "mot a" et "mot b". la partie de la macro doit isoler et copier toutes les lignes entre ces deux mots.

Le pb est que je ne sais pas comment faire? pouvez vous m'aider à trouver la solution?

Sub macro_Pilotage()

Dim vDerniereligne As Long 'long valeur comprise entre - 2 000 000 et 2 000 000
Dim lien As Range 'désigne une plage de cellule
Dim nDerniereligne As Long
Dim vligne As Long

vDerniereligne = ActiveSheet.UsedRange.Rows.Count 'numéro dernière ligne affectée à la variable vderniereligne 'usedrange = plage de cellule''rows.count = renvoie le nombre de ligne
lien = ThisWorkbook.Sheets("parametrages").Range("A1:A4") 'plage de la boucle des cellules
test = Timer 'permet de chrono la macro

Application.DisplayAlerts = False 'etat d'affichage des messages d'alerte d'excel ici désactiver

On Error Resume Next 'Si erreur fin de la macro

For Each cell In lien

    ActiveWorkbook.FollowHyperlink 'ouvre les liens dans les cellules
    UpdateLinks = True 'active les liaisons

    Sheets("yy").Select ' selectionne la feuille ou les données sont
    [color=#FF0000]'TO DO besoin de votre aide pour sélectionner les lignes entre les deux mots[/color]
    Selection.Copy ' copy les données

    Windows("xx.xlsm").Activate 'active le classeur ou les données doivent être collées
    Sheets("BDD").Activate 'active la feuille ou les données doivent être collées
    For vDerniereligne = 1 To .Range("B65536").End(xlUp).Row + 1 'cherche la dernière ligne et se met sur la ligne suivante

    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False 'collage spécial en valeur
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'collage spécial en valeur

    For vligne = nDerniereligne To 1 Step -1 'passe en revue chaque ligne en commençant par la dernière ex 88 87 86
    If Application.CountA(Rows(vligne)) = 0 Then 'compte le nombre de cellule présent dans la ligne pointée
    Rows(vligne).Delete 'si le résultat est 0 donc la ligne est delete
    If Application.CountA(Rows(vligne)) = "TBC" Then 'compte le nombre de cellule présent dans la ligne pointée
    Rows(vligne).Delete 'si le résultat est TBC donc la ligne est delete
    End If

Next
Next
res_test = Format(Timer - test, "0" & Application.DecimalSeparator & "000")
Application.DisplayAlerts = True 'etat d'affichage des messages d'alerte d'excel ici activer
dd = MsgBox(nb & " Temps de la macro (en " & res_test & " secondes)", 64, "Résultat") 'Box du temps de la macro

End Sub

Je vous remercie de votre aide par avance.

Fichier en PJ pour mieux comprendre si je ne suis pas clair au dessus.

Bonjour,

bien vu l'espace après "mot b" sur ta feuille pour tromper l'ennemi...

    Dim c1 As Range, c2 As Range
    Set c1 = Columns(1).Find("mot a", LookIn:=xlValues, lookat:=xlWhole)
    Set c2 = Columns(1).Find("mot b", LookIn:=xlValues, lookat:=xlWhole)
    If c1 Is Nothing Or c2 Is Nothing Then MsgBox "y'a un os !": Exit Sub
    Range(c1, c2).EntireRow.Copy

eric

Ah mince désolé pour cet espace...

En tout cas merci Erci pour ton aide.

Je vais essayer de faire la macro combiné avec tout ça cette semaine au travail.

En espérant que le reste de la macro fonctionne ^^ .

Bonne soirée

Julien

En tout cas, j'ai testé ton code et fonctionne parfaitement

Merci beaucoup.

Je vais créer un autre topic car ma boucle ne fonctionne pas..

Merci et bonne fêtes de fin d'années.