Copie de feuilles d'un classeur dans un autre selon certaines conditions

Bonjour à tous,

J'aimerais avoir de l'aide afin de concevoir une macro qui me permettra de copier toutes les feuilles d'un classeur (nom quelconque, *.XLS*) contenant uniquement les caractères "Équipement :" en "B3" dans un fichier cible actif ouvert (nom quelconque). La feuille nommée "MODEL" du fichier source sera exclue de la copie. La macro sera exécutée à partir du fichier cible.

J'ai écris ci-dessous une exquise de macro pour effectuer ce que je désire. Les lignes "x" sont à compléter. Si vous pourriez modifier ou améliorer les lignes de programme déjà écrites, cela serait très apprécié.

Sub Fichier_source()

' Ouvre un fichier source

Dim wb As Workbook

With Application.FileDialog(msoFileDialogFilePicker)

.AllowMultiSelect = True

.Title = "Choisir un fichier source (feuilles à copier)"

.Filters.Clear

.Filters.Add "Excel files", "*.XLS*"

If .Show = 0 Then

MsgBox "Pas de fichier sélectionné": Exit Sub

Else

For i = 1 To .SelectedItems.Count

Set wb = Workbooks.Open(.SelectedItems(i), , True) 'ouverture en lecture seule

Call Copier_Feuilles_vers_fichier_cible(wb)

' MsgBox "Transferts du fichier " & wb.Name & " effectués"

wb.Close (False)

Next i

End If

End With

Application.DisplayAlerts = False

' ActiveWindow.SelectedSheets.Delete

Application.DisplayAlerts = True

End Sub

'

'

Sub Copier_Feuilles_vers_fichier_cible(classeur_IST As Object)

' copie des données dans les fiches applications

For Each Ws In classeur_IST.Worksheets

If Ws.Range("B3") = "Équipement :" _

And Ws.Name <> "MODEL" Then ' feuille données

x

x

x

x

x

x

x

x

End If

Next

Application.ScreenUpdating = True

Application.EnableEvents = True

Set wsa = Nothing

End Sub

Merci à l'avance pour votre précieuse collaboration,

Renaud D.