Fusionner macros

Bonjour,
Débutante en macro j'ai créé plusieurs macros pour répondre à un besoin de recherche de mots-clés qui pour chacun permettent de copier des données dans des colonnes. Je souhaiterais que de ces 11 macros je n'en ai plus qu'une. Pouvez vous m'aider afin de me faire gagner du temps dans l'execution.

Sub ExtraireDonnees()
    Dim wbSource As Workbook, wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim motCle As String
    Dim rngSource As Range, rngResultat As Range
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim dataFound As Boolean

    ' Récupérer le mot-clé en A1 de la feuille "Bilan FPZ GE U7"
    motCle = ThisWorkbook.Sheets("Bilan FPZ GE U7").Range("A1").Value

    ' Vérifier si la cellule contenant le mot-clé est vide
    If motCle = "" Then
        MsgBox "Aucun mot-clé à rechercher. La macro s'arrête.", vbInformation
        Exit Sub
    End If

    ' Ouvrir le fichier source qui contient la macro
    Set wbSource = Workbooks.Open(ThisWorkbook.Path & "\Licences_FB.xlsm")
    Set wsSource = wbSource.Sheets("FPZ")
    Set wsDestination = ThisWorkbook.Sheets("Bilan FPZ GE U7")

    ' Récupérer le mot-clé en A1 de la feuille "Bilan FPZ GE U7"
    motCle = wsDestination.Range("A1").Value

    With wsSource
        ' Appliquer le filtre pour le mot-clé dans la colonne A de la feuille FPZ
        .AutoFilterMode = False
        .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=motCle

        ' Trouver la dernière ligne de données filtrées dans la colonne A de la feuille FPZ
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Vérifier si des données ont été trouvées
    If lastRow > 3 Then
    ' Copier les données filtrées de la colonne B à F et la colonne N (sans les entêtes) dans la feuille "Bilan FPZ GE U7" à partir de A4
    Set rngResultat = wsDestination.Range("A4")
    For i = 2 To 6 ' Copier les colonnes B à F
        .Range(.Cells(2, i), .Cells(lastRow, i)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)
        j = j + 1
    Next i

    ' Copier la colonne N
    .Range(.Cells(2, 14), .Cells(lastRow, 14)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)

            dataFound = True
        End If

        ' Supprimer le filtre
        .AutoFilterMode = False
    End With

    ' Fermer le fichier source sans sauvegarder les modifications
    wbSource.Close SaveChanges:=False

    ' Afficher un message si aucune donnée n'a été trouvée et quitter la procédure
    If Not dataFound Then
        MsgBox "Aucune donnée correspondante n'a été trouvée.", vbInformation
        Exit Sub
    End If

    MsgBox "Données extraites avec succès !"
End Sub

Sub ExtraireDonnees_A60()
    Dim wbSource As Workbook, wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim motCle As String
    Dim rngSource As Range, rngResultat As Range
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim dataFound As Boolean

    ' Récupérer le mot-clé en A60 de la feuille "Bilan FPZ GE U7"
    motCle = ThisWorkbook.Sheets("Bilan FPZ GE U7").Range("A60").Value

    ' Vérifier si la cellule contenant le mot-clé est vide
    If motCle = "" Then
        MsgBox "Aucun mot-clé à rechercher. La macro s'arrête.", vbInformation
        Exit Sub
    End If

    ' Ouvrir le fichier source qui contient la macro
    Set wbSource = Workbooks.Open(ThisWorkbook.Path & "\Licences_FB.xlsm")
    Set wsSource = wbSource.Sheets("FPZ")
    Set wsDestination = ThisWorkbook.Sheets("Bilan FPZ GE U7")

    ' Récupérer le mot-clé en A60 de la feuille "Bilan FPZ GE U7"
    motCle = wsDestination.Range("A60").Value

    With wsSource
        ' Appliquer le filtre pour le mot-clé dans la colonne A de la feuille FPZ
        .AutoFilterMode = False
        .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=motCle

        ' Trouver la dernière ligne de données filtrées dans la colonne A de la feuille FPZ
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Vérifier si des données ont été trouvées
    If lastRow > 3 Then
    ' Copier les données filtrées de la colonne B à F et la colonne N (sans les entêtes) dans la feuille "Bilan FPZ GE U7" à partir de A63
    Set rngResultat = wsDestination.Range("A63")
    For i = 2 To 6 ' Copier les colonnes B à F
        .Range(.Cells(2, i), .Cells(lastRow, i)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)
        j = j + 1
    Next i

    ' Copier la colonne N
    .Range(.Cells(2, 14), .Cells(lastRow, 14)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)

            dataFound = True
        End If

        ' Supprimer le filtre
        .AutoFilterMode = False
    End With

    ' Fermer le fichier source sans sauvegarder les modifications
    wbSource.Close SaveChanges:=False

    ' Afficher un message si aucune donnée n'a été trouvée et quitter la procédure
    If Not dataFound Then
        MsgBox "Aucune donnée correspondante n'a été trouvée.", vbInformation
        Exit Sub
    End If

    MsgBox "Données extraites avec succès !"
End Sub

Sub ExtraireDonnees_A118()
    Dim wbSource As Workbook, wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim motCle As String
    Dim rngSource As Range, rngResultat As Range
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim dataFound As Boolean

    ' Récupérer le mot-clé en A118 de la feuille "Bilan FPZ GE U7"
    motCle = ThisWorkbook.Sheets("Bilan FPZ GE U7").Range("A118").Value

    ' Vérifier si la cellule contenant le mot-clé est vide
    If motCle = "" Then
        MsgBox "Aucun mot-clé à rechercher. La macro s'arrête.", vbInformation
        Exit Sub
    End If

    ' Ouvrir le fichier source qui contient la macro
    Set wbSource = Workbooks.Open(ThisWorkbook.Path & "\Licences_FB.xlsm")
    Set wsSource = wbSource.Sheets("FPZ")
    Set wsDestination = ThisWorkbook.Sheets("Bilan FPZ GE U7")

    ' Récupérer le mot-clé en A118 de la feuille "Bilan FPZ GE U7"
    motCle = wsDestination.Range("A118").Value

    With wsSource
        ' Appliquer le filtre pour le mot-clé dans la colonne A de la feuille FPZ
        .AutoFilterMode = False
        .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=motCle

        ' Trouver la dernière ligne de données filtrées dans la colonne A de la feuille FPZ
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Vérifier si des données ont été trouvées
    If lastRow > 3 Then
    ' Copier les données filtrées de la colonne B à F et la colonne N (sans les entêtes) dans la feuille "Bilan FPZ GE U7" à partir de A121
    Set rngResultat = wsDestination.Range("A121")
    For i = 2 To 6 ' Copier les colonnes B à F
        .Range(.Cells(2, i), .Cells(lastRow, i)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)
        j = j + 1
    Next i

    ' Copier la colonne N
    .Range(.Cells(2, 14), .Cells(lastRow, 14)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)

            dataFound = True
        End If

        ' Supprimer le filtre
        .AutoFilterMode = False
    End With

    ' Fermer le fichier source sans sauvegarder les modifications
    wbSource.Close SaveChanges:=False

    ' Afficher un message si aucune donnée n'a été trouvée et quitter la procédure
    If Not dataFound Then
        MsgBox "Aucune donnée correspondante n'a été trouvée.", vbInformation
        Exit Sub
    End If

    MsgBox "Données extraites avec succès !"
End Sub
Sub ExtraireDonnees_A176()
    Dim wbSource As Workbook, wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim motCle As String
    Dim rngSource As Range, rngResultat As Range
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim dataFound As Boolean

    ' Récupérer le mot-clé en A176 de la feuille "Bilan FPZ GE U7"
    motCle = ThisWorkbook.Sheets("Bilan FPZ GE U7").Range("A176").Value

    ' Vérifier si la cellule contenant le mot-clé est vide
    If motCle = "" Then
        MsgBox "Aucun mot-clé à rechercher. La macro s'arrête.", vbInformation
        Exit Sub
    End If

    ' Ouvrir le fichier source qui contient la macro
    Set wbSource = Workbooks.Open(ThisWorkbook.Path & "\Licences_FB.xlsm")
    Set wsSource = wbSource.Sheets("FPZ")
    Set wsDestination = ThisWorkbook.Sheets("Bilan FPZ GE U7")

    ' Récupérer le mot-clé en A176 de la feuille "Bilan FPZ GE U7"
    motCle = wsDestination.Range("A176").Value

    With wsSource
        ' Appliquer le filtre pour le mot-clé dans la colonne A de la feuille FPZ
        .AutoFilterMode = False
        .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=motCle

        ' Trouver la dernière ligne de données filtrées dans la colonne A de la feuille FPZ
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Vérifier si des données ont été trouvées
    If lastRow > 3 Then
    ' Copier les données filtrées de la colonne B à F et la colonne N (sans les entêtes) dans la feuille "Bilan FPZ GE U7" à partir de A179
    Set rngResultat = wsDestination.Range("A179")
    For i = 2 To 6 ' Copier les colonnes B à F
        .Range(.Cells(2, i), .Cells(lastRow, i)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)
        j = j + 1
    Next i

    ' Copier la colonne N
    .Range(.Cells(2, 14), .Cells(lastRow, 14)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)

            dataFound = True
        End If

        ' Supprimer le filtre
        .AutoFilterMode = False
    End With

    ' Fermer le fichier source sans sauvegarder les modifications
    wbSource.Close SaveChanges:=False

    ' Afficher un message si aucune donnée n'a été trouvée et quitter la procédure
    If Not dataFound Then
        MsgBox "Aucune donnée correspondante n'a été trouvée.", vbInformation
        Exit Sub
    End If

    MsgBox "Données extraites avec succès !"
End Sub
Sub ExtraireDonnees_A234()
    Dim wbSource As Workbook, wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim motCle As String
    Dim rngSource As Range, rngResultat As Range
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim dataFound As Boolean

    ' Récupérer le mot-clé en A234 de la feuille "Bilan FPZ GE U7"
    motCle = ThisWorkbook.Sheets("Bilan FPZ GE U7").Range("A234").Value

    ' Vérifier si la cellule contenant le mot-clé est vide
    If motCle = "" Then
        MsgBox "Aucun mot-clé à rechercher. La macro s'arrête.", vbInformation
        Exit Sub
    End If

    ' Ouvrir le fichier source qui contient la macro
    Set wbSource = Workbooks.Open(ThisWorkbook.Path & "\Licences_FB.xlsm")
    Set wsSource = wbSource.Sheets("FPZ")
    Set wsDestination = ThisWorkbook.Sheets("Bilan FPZ GE U7")

    ' Récupérer le mot-clé en A234 de la feuille "Bilan FPZ GE U7"
    motCle = wsDestination.Range("A234").Value

    With wsSource
        ' Appliquer le filtre pour le mot-clé dans la colonne A de la feuille FPZ
        .AutoFilterMode = False
        .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=motCle

        ' Trouver la dernière ligne de données filtrées dans la colonne A de la feuille FPZ
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Vérifier si des données ont été trouvées
    If lastRow > 3 Then
    ' Copier les données filtrées de la colonne B à F et la colonne N (sans les entêtes) dans la feuille "Bilan FPZ GE U7" à partir de A237
    Set rngResultat = wsDestination.Range("A237")
    For i = 2 To 6 ' Copier les colonnes B à F
        .Range(.Cells(2, i), .Cells(lastRow, i)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)
        j = j + 1
    Next i

    ' Copier la colonne N
    .Range(.Cells(2, 14), .Cells(lastRow, 14)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)

            dataFound = True
        End If

        ' Supprimer le filtre
        .AutoFilterMode = False
    End With

    ' Fermer le fichier source sans sauvegarder les modifications
    wbSource.Close SaveChanges:=False

    ' Afficher un message si aucune donnée n'a été trouvée et quitter la procédure
    If Not dataFound Then
        MsgBox "Aucune donnée correspondante n'a été trouvée.", vbInformation
        Exit Sub
    End If

    MsgBox "Données extraites avec succès !"
End Sub

Sub ExtraireDonnees_A295()
    Dim wbSource As Workbook, wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim motCle As String
    Dim rngSource As Range, rngResultat As Range
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim dataFound As Boolean

    ' Récupérer le mot-clé en A295 de la feuille "Bilan FPZ GE U7"
    motCle = ThisWorkbook.Sheets("Bilan FPZ GE U7").Range("A295").Value

    ' Vérifier si la cellule contenant le mot-clé est vide
    If motCle = "" Then
        MsgBox "Aucun mot-clé à rechercher. La macro s'arrête.", vbInformation
        Exit Sub
    End If

    ' Ouvrir le fichier source qui contient la macro
    Set wbSource = Workbooks.Open(ThisWorkbook.Path & "\Licences_FB.xlsm")
    Set wsSource = wbSource.Sheets("FPZ")
    Set wsDestination = ThisWorkbook.Sheets("Bilan FPZ GE U7")

    ' Récupérer le mot-clé en A295 de la feuille "Bilan FPZ GE U7"
    motCle = wsDestination.Range("A295").Value

    With wsSource
        ' Appliquer le filtre pour le mot-clé dans la colonne A de la feuille FPZ
        .AutoFilterMode = False
        .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=motCle

        ' Trouver la dernière ligne de données filtrées dans la colonne A de la feuille FPZ
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Vérifier si des données ont été trouvées
    If lastRow > 3 Then
    ' Copier les données filtrées de la colonne B à F et la colonne N (sans les entêtes) dans la feuille "Bilan FPZ GE U7" à partir de A298
    Set rngResultat = wsDestination.Range("A298")
    For i = 2 To 6 ' Copier les colonnes B à F
        .Range(.Cells(2, i), .Cells(lastRow, i)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)
        j = j + 1
    Next i

    ' Copier la colonne N
    .Range(.Cells(2, 14), .Cells(lastRow, 14)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)

            dataFound = True
        End If

        ' Supprimer le filtre
        .AutoFilterMode = False
    End With

    ' Fermer le fichier source sans sauvegarder les modifications
    wbSource.Close SaveChanges:=False

    ' Afficher un message si aucune donnée n'a été trouvée et quitter la procédure
    If Not dataFound Then
        MsgBox "Aucune donnée correspondante n'a été trouvée.", vbInformation
        Exit Sub
    End If

    MsgBox "Données extraites avec succès !"
End Sub

Sub ExtraireDonnees_A373()
    Dim wbSource As Workbook, wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim motCle As String
    Dim rngSource As Range, rngResultat As Range
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim dataFound As Boolean

    ' Récupérer le mot-clé en A373 de la feuille "Bilan FPZ GE U7"
    motCle = ThisWorkbook.Sheets("Bilan FPZ GE U7").Range("A373").Value

    ' Vérifier si la cellule contenant le mot-clé est vide
    If motCle = "" Then
        MsgBox "Aucun mot-clé à rechercher. La macro s'arrête.", vbInformation
        Exit Sub
    End If

    ' Ouvrir le fichier source qui contient la macro
    Set wbSource = Workbooks.Open(ThisWorkbook.Path & "\Licences_FB.xlsm")
    Set wsSource = wbSource.Sheets("FPZ")
    Set wsDestination = ThisWorkbook.Sheets("Bilan FPZ GE U7")

    ' Récupérer le mot-clé en A373 de la feuille "Bilan FPZ GE U7"
    motCle = wsDestination.Range("A373").Value

    With wsSource
        ' Appliquer le filtre pour le mot-clé dans la colonne A de la feuille FPZ
        .AutoFilterMode = False
        .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=motCle

        ' Trouver la dernière ligne de données filtrées dans la colonne A de la feuille FPZ
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Vérifier si des données ont été trouvées
    If lastRow > 3 Then
    ' Copier les données filtrées de la colonne B à F et la colonne N (sans les entêtes) dans la feuille "Bilan FPZ GE U7" à partir de A376
    Set rngResultat = wsDestination.Range("A376")
    For i = 2 To 6 ' Copier les colonnes B à F
        .Range(.Cells(2, i), .Cells(lastRow, i)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)
        j = j + 1
    Next i

    ' Copier la colonne N
    .Range(.Cells(2, 14), .Cells(lastRow, 14)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)

            dataFound = True
        End If

        ' Supprimer le filtre
        .AutoFilterMode = False
    End With

    ' Fermer le fichier source sans sauvegarder les modifications
    wbSource.Close SaveChanges:=False

    ' Afficher un message si aucune donnée n'a été trouvée et quitter la procédure
    If Not dataFound Then
        MsgBox "Aucune donnée correspondante n'a été trouvée.", vbInformation
        Exit Sub
    End If

    MsgBox "Données extraites avec succès !"
End Sub
Sub ExtraireDonnees_A433()
    Dim wbSource As Workbook, wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim motCle As String
    Dim rngSource As Range, rngResultat As Range
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim dataFound As Boolean

    ' Récupérer le mot-clé en A433 de la feuille "Bilan FPZ GE U7"
    motCle = ThisWorkbook.Sheets("Bilan FPZ GE U7").Range("A433").Value

    ' Vérifier si la cellule contenant le mot-clé est vide
    If motCle = "" Then
        MsgBox "Aucun mot-clé à rechercher. La macro s'arrête.", vbInformation
        Exit Sub
    End If

    ' Ouvrir le fichier source qui contient la macro
    Set wbSource = Workbooks.Open(ThisWorkbook.Path & "\Licences_FB.xlsm")
    Set wsSource = wbSource.Sheets("FPZ")
    Set wsDestination = ThisWorkbook.Sheets("Bilan FPZ GE U7")

    ' Récupérer le mot-clé en A433 de la feuille "Bilan FPZ GE U7"
    motCle = wsDestination.Range("A433").Value

    With wsSource
        ' Appliquer le filtre pour le mot-clé dans la colonne A de la feuille FPZ
        .AutoFilterMode = False
        .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=motCle

        ' Trouver la dernière ligne de données filtrées dans la colonne A de la feuille FPZ
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Vérifier si des données ont été trouvées
    If lastRow > 3 Then
    ' Copier les données filtrées de la colonne B à F et la colonne N (sans les entêtes) dans la feuille "Bilan FPZ GE U7" à partir de A436
    Set rngResultat = wsDestination.Range("A436")
    For i = 2 To 6 ' Copier les colonnes B à F
        .Range(.Cells(2, i), .Cells(lastRow, i)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)
        j = j + 1
    Next i

    ' Copier la colonne N
    .Range(.Cells(2, 14), .Cells(lastRow, 14)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)

            dataFound = True
        End If

        ' Supprimer le filtre
        .AutoFilterMode = False
    End With

    ' Fermer le fichier source sans sauvegarder les modifications
    wbSource.Close SaveChanges:=False

    ' Afficher un message si aucune donnée n'a été trouvée et quitter la procédure
    If Not dataFound Then
        MsgBox "Aucune donnée correspondante n'a été trouvée.", vbInformation
        Exit Sub
    End If

    MsgBox "Données extraites avec succès !"
End Sub
Sub ExtraireDonnees_A491()
    Dim wbSource As Workbook, wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim motCle As String
    Dim rngSource As Range, rngResultat As Range
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim dataFound As Boolean

    ' Récupérer le mot-clé en A491 de la feuille "Bilan FPZ GE U7"
    motCle = ThisWorkbook.Sheets("Bilan FPZ GE U7").Range("A491").Value

    ' Vérifier si la cellule contenant le mot-clé est vide
    If motCle = "" Then
        MsgBox "Aucun mot-clé à rechercher. La macro s'arrête.", vbInformation
        Exit Sub
    End If

    ' Ouvrir le fichier source qui contient la macro
    Set wbSource = Workbooks.Open(ThisWorkbook.Path & "\Licences_FB.xlsm")
    Set wsSource = wbSource.Sheets("FPZ")
    Set wsDestination = ThisWorkbook.Sheets("Bilan FPZ GE U7")

    ' Récupérer le mot-clé en A491 de la feuille "Bilan FPZ GE U7"
    motCle = wsDestination.Range("A491").Value

    With wsSource
        ' Appliquer le filtre pour le mot-clé dans la colonne A de la feuille FPZ
        .AutoFilterMode = False
        .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=motCle

        ' Trouver la dernière ligne de données filtrées dans la colonne A de la feuille FPZ
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Vérifier si des données ont été trouvées
    If lastRow > 3 Then
    ' Copier les données filtrées de la colonne B à F et la colonne N (sans les entêtes) dans la feuille "Bilan FPZ GE U7" à partir de A494
    Set rngResultat = wsDestination.Range("A494")
    For i = 2 To 6 ' Copier les colonnes B à F
        .Range(.Cells(2, i), .Cells(lastRow, i)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)
        j = j + 1
    Next i

    ' Copier la colonne N
    .Range(.Cells(2, 14), .Cells(lastRow, 14)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)

            dataFound = True
        End If

        ' Supprimer le filtre
        .AutoFilterMode = False
    End With

    ' Fermer le fichier source sans sauvegarder les modifications
    wbSource.Close SaveChanges:=False

    ' Afficher un message si aucune donnée n'a été trouvée et quitter la procédure
    If Not dataFound Then
        MsgBox "Aucune donnée correspondante n'a été trouvée.", vbInformation
        Exit Sub
    End If

    MsgBox "Données extraites avec succès !"
End Sub

Sub ExtraireDonnees_A549()
    Dim wbSource As Workbook, wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim motCle As String
    Dim rngSource As Range, rngResultat As Range
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim dataFound As Boolean

    ' Récupérer le mot-clé en A549 de la feuille "Bilan FPZ GE U7"
    motCle = ThisWorkbook.Sheets("Bilan FPZ GE U7").Range("A549").Value

    ' Vérifier si la cellule contenant le mot-clé est vide
    If motCle = "" Then
        MsgBox "Aucun mot-clé à rechercher. La macro s'arrête.", vbInformation
        Exit Sub
    End If

    ' Ouvrir le fichier source qui contient la macro
    Set wbSource = Workbooks.Open(ThisWorkbook.Path & "\Licences_FB.xlsm")
    Set wsSource = wbSource.Sheets("FPZ")
    Set wsDestination = ThisWorkbook.Sheets("Bilan FPZ GE U7")

    ' Récupérer le mot-clé en A549 de la feuille "Bilan FPZ GE U7"
    motCle = wsDestination.Range("A549").Value

    With wsSource
        ' Appliquer le filtre pour le mot-clé dans la colonne A de la feuille FPZ
        .AutoFilterMode = False
        .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=motCle

        ' Trouver la dernière ligne de données filtrées dans la colonne A de la feuille FPZ
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Vérifier si des données ont été trouvées
    If lastRow > 3 Then
    ' Copier les données filtrées de la colonne B à F et la colonne N (sans les entêtes) dans la feuille "Bilan FPZ GE U7" à partir de A552
    Set rngResultat = wsDestination.Range("A552")
    For i = 2 To 6 ' Copier les colonnes B à F
        .Range(.Cells(2, i), .Cells(lastRow, i)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)
        j = j + 1
    Next i

    ' Copier la colonne N
    .Range(.Cells(2, 14), .Cells(lastRow, 14)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)

            dataFound = True
        End If

        ' Supprimer le filtre
        .AutoFilterMode = False
    End With

    ' Fermer le fichier source sans sauvegarder les modifications
    wbSource.Close SaveChanges:=False

    ' Afficher un message si aucune donnée n'a été trouvée et quitter la procédure
    If Not dataFound Then
        MsgBox "Aucune donnée correspondante n'a été trouvée.", vbInformation
        Exit Sub
    End If

    MsgBox "Données extraites avec succès !"
End Sub
Sub ExtraireDonnees_A611()
    Dim wbSource As Workbook, wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim motCle As String
    Dim rngSource As Range, rngResultat As Range
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim dataFound As Boolean

    ' Récupérer le mot-clé en A611 de la feuille "Bilan FPZ GE U7"
    motCle = ThisWorkbook.Sheets("Bilan FPZ GE U7").Range("A611").Value

    ' Vérifier si la cellule contenant le mot-clé est vide
    If motCle = "" Then
        MsgBox "Aucun mot-clé à rechercher. La macro s'arrête.", vbInformation
        Exit Sub
    End If

    ' Ouvrir le fichier source qui contient la macro
    Set wbSource = Workbooks.Open(ThisWorkbook.Path & "\Licences_FB.xlsm")
    Set wsSource = wbSource.Sheets("FPZ")
    Set wsDestination = ThisWorkbook.Sheets("Bilan FPZ GE U7")

    ' Récupérer le mot-clé en A611 de la feuille "Bilan FPZ GE U7"
    motCle = wsDestination.Range("A611").Value

    With wsSource
        ' Appliquer le filtre pour le mot-clé dans la colonne A de la feuille FPZ
        .AutoFilterMode = False
        .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=motCle

        ' Trouver la dernière ligne de données filtrées dans la colonne A de la feuille FPZ
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Vérifier si des données ont été trouvées
    If lastRow > 3 Then
    ' Copier les données filtrées de la colonne B à F et la colonne N (sans les entêtes) dans la feuille "Bilan FPZ GE U7" à partir de A614
    Set rngResultat = wsDestination.Range("A614")
    For i = 2 To 6 ' Copier les colonnes B à F
        .Range(.Cells(2, i), .Cells(lastRow, i)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)
        j = j + 1
    Next i

    ' Copier la colonne N
    .Range(.Cells(2, 14), .Cells(lastRow, 14)).SpecialCells(xlCellTypeVisible).Copy rngResultat.Offset(0, j)

            dataFound = True
        End If

        ' Supprimer le filtre
        .AutoFilterMode = False
    End With

    ' Fermer le fichier source sans sauvegarder les modifications
    wbSource.Close SaveChanges:=False

    ' Afficher un message si aucune donnée n'a été trouvée et quitter la procédure
    If Not dataFound Then
        MsgBox "Aucune donnée correspondante n'a été trouvée.", vbInformation
        Exit Sub
    End If

    MsgBox "Données extraites avec succès !"
End Sub

Merci par avance de votre aide.

Bonne journée

Bea

Bonjour, je vous déconseilles de faire un copié collé de vos 11 macros pour les ramener dans une seule.

Je peux voir dans vos lignes de code des : "exit sub" autrement dit à un moment excel risque de sortie et ne pas continuer la suite.

Le plus simple :

Vous créez une nouvelle macro dans laquelle vous écrivez le noms des 11 macros. ( 1 à chaque ligne )

( elles seront lancées les unes après les autres )

Merci de votre réactivité. Je vais faire un test et si besoin reviendrais vers vous.

Cela est effectivement plus simple. Merci à vous

pas de souci.