XL 2010 Copie de feuilles d'un classeur dans un autre selon certains critères

[Renaud22]

Bonjour à tous,

J'aimerais avoir de l'aide afin de concevoir une macro qui me permettra de copier toutes les feuilles visibles d'un classeur (nom quelconque, *.XLS*, classeur source) contenant uniquement les caractères "Équipement :" en "B3" dans un classeur cible actif ouvert (nom quelconque). La feuille nommée "MODEL" du classeur source sera exclue de la copie. La macro sera exécutée à partir du classeur cible. Je joins un exemple de classeur source (nombre de feuilles variable). En fonction des critères précédemment déterminés, une fois la macro exécutée, seules les feuilles jaunes devraient être copiées dans le classeur 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 classeur source
Dim wb As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Title = "Choisir un classeur source (feuilles à copier)"
.Filters.Clear
.Filters.Add "Excel files", "*.XLS*"
If .Show = 0 Then
MsgBox "Pas de classeur sélectionné": Exit Sub
Else
For i = 1 To .SelectedItems.Count
Set wb = Workbooks.Open(.SelectedItems(i), , True) 'ouverture en lecture seule
Call Copier_classeur_source_vers_classeur_cible(wb)
' MsgBox "Transfert des feuilles" & wb.Name & " effectué"
wb.Close (False)
Next i
End If
End With
Application.DisplayAlerts = False
' ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End Sub
'
'
Sub Copier_classeur_source_vers_classeur_cible(classeur_IST As Object)
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,

Renaud22.

 

[fanfan38]

Quelle différence avec le post précédent?
On reprend le même (fichier cible) ou on modifie le fichier source?
si c'est le cas remplacer la macro copier par celle ci

Sub copier(wb)
  Dim nb As Integer
  With wb
   For nb = 1 To .Sheets.Count
    If .Sheets(nb).Range("B3").Value = "Équipement :" And .Sheets(nb).Name <> "MODEL" Then
      .Sheets(nb).Copy After:=fich.Sheets(fich.Sheets.Count)
    End If
   Next
  End With
End Sub

A+ François

 

[Renaud22]

Bonjour fanfan38,
Ce post est une nouvelle macro pour effectuer une tâche différente. A l'intérieur du classeur cible, je dois exécuter 2 macros ("Copie de feuilles d'un classeur dans un autre selon certains critères" (macro1) & "Copier des feuilles d'un classeur à partir de données identiques" (macro2)).
La différence entre cette macro (macro1) et la précédente (macro2) est qu'il n'y a plus de comparaison à faire entre deux valeurs identiques dans une même cellule (cellule "D9"). Je dois simplement copier toutes les feuilles d'un classeur à l'exception de celle nommée "MODEL" et celles qui n'ont pas les caractères "Équipement :" en "B3". La macro la plus complexe (macro2) à concevoir était celle que vous m'avez envoyée. Je pensais pouvoir adapter cette macro afin de copier des feuilles d'un autre classeur selon les critères définis précédemment mais sans succès. Manifestement, je ne suis pas un expert en programmation VBA et c'est pour cela que j'ai besoin d'aide. Le classeur cible dans lequel sera exécuter la macro1 peut être un classeur vierge ou identique au classeur cible (macro2) puisqu'il n'y a plus de comparaison à faire en "D9". Le nouveau classeur source est celui joint dans ce post (classeur source.xlsx). Il est donc différent de celui utilisé pour exécuter la macro2.

Sincères salutations,

Renaud22

 

[fanfan38]

donc dans ton nouveau classeur cible tu copie la macro mamacro du précédent post et tu copie la macro ci dessus...
A+ François

 

[Renaud22]

Pourriez-vous SVP modifier légèrement votre macro mamacro et la mettre en pièce jointe.

 

[fanfan38]

Quelle modif souhaites tu?

 

[Renaud22]

Bonsoir fanfan38,
Après vérification des messages antérieurs, je me suis rendu compte que j'avais omis de consulter adéquatement votre réponse à ma demande. Je n'avais pas vu la macro que vous avez conçu. Je vous prie de m'en excuser. Cette dernière macro fonctionne très bien. Avec les 2 macros que vous avez eu l'amabilité de me transmettre ces dernières 24 heures, je peux donc avancer dans mon projet.
Sincères remerciements et salutations à vous.
Renaud22

 

[fanch55]

Bonsoir le fil,
@Renaud22
Ne pas oublier de clore les discussions en désignant le post qui vous semble une solution .
Merci par avance .