Bonjour à tous,
J'aurais besoin qu'on aide à concevoir une macro qui permettrait de copier des feuilles d'un classeur contenant des données dans un autre classeur selon certains critères.
Comme exemple, je joins les classeurs source, cible et résultat.
Le nom du classeur cible est quelconque. Aucun nom doit être assigné au classeur cible. Il constitue uniquement le classeur actif (ouvert) à partir duquel la macro sera exécutée.
Le nombre de feuilles est variable. La cellule "I3" dans toutes les feuilles contient une donnée quelconque (différente de "X", cellule non vide). Une donnée de référence quelconque et distincte est contenue dans la cellule "D9" dans chacune des feuilles du classeur.
Le nom du classeur source est quelconque. Aucun nom doit être assigné au classeur source. Le nombre de feuilles est variable. La cellule "I17" dans toutes les feuilles contient une donnée quelconque (différente de "X", cellule non vide). Une donnée de référence distincte est contenue dans la cellule "D9" dans chacune des feuilles du classeur. Le nom de chacune des feuilles est associé à la valeur de référence ("D9").
Lorsque la macro est exécutée à partir du classeur cible, une boîte de dialogue doit s'ouvrir et nous demander de choisir un classeur source quelconque comme dans l'exemple ci-dessous :
********************************************************************************************************************************
Dim wb As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Title = "Choisir un fichier source quelconque"
.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_Données_classeur_source_vers_classeur_cible(wb)
'
MsgBox "Transferts du fichier " & wb.Name & " effectués"
wb.Close (False)
Next i
End If
End With
Sheets("DE_MODEL").Select
Application.DisplayAlerts = False
' ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End Sub
'
Copier_Données_classeur_source_vers_classeur_cible ()
x
x
x
x
End Sub
********************************************************************************************************************************
La macro doit comparer les valeurs de référence en "D9" dans les classeurs cible et source et copier uniquement les feuilles du classeur source qui sont identiques aux valeurs de référence en "D9" du classeur cible.
Dans le classeur cible, seules les feuilles dont les cellules en "D9" et "I3" qui sont "non vides" seront comparées avec celles du classeur source. Dans le classeur source, seules les feuilles dont les cellules en "D9" et "I17" qui sont "non vides" seront comparées avec celles du classeur cible. Ces différents tests dans les classeurs cible et source sont nécessaires car ces classeurs peuvent contenir d'autres types de feuilles que celles représentées dans les classeurs joints.
Lorsque que les feuilles appropriées du classeur source seront copiées dans le classeur cible, le classeur source doit être fermé. Seul le classeur cible doit demeuré ouvert.
A titre d'exemple, le résultat de cette comparaison et la copie des feuilles donc les valeurs sont identiques en "D9" est représenté dans le fichier "Classeur résultat" ci-joint. Le classeur résultat est le classeur cible. Le classeur résultat ne représente pas un nouveau classeur qui devra être créé.
En résumé, les classeurs cible et source peuvent avoir des noms quelconque. Le nombre de feuilles dans ces classeurs est variable. Dans le classeur cible, seules les feuilles avec des données dans les cellules "D9" et "I3" seront prises en compte. Dans le classeur source, seules les feuilles avec des données dans les cellules "D9" et "I17" seront prises en compte. Les valeurs de référence dans les 2 classeurs sont situées dans la cellule "D9". Seules les feuilles dont les valeurs de référence identiques seront copiées dans le classeur cible.
Si vous avez des questions, n'hésitez pas à me contacter.
Merci à l'avance pour votre précieuse collaboration,
Renaud22
J'aurais besoin qu'on aide à concevoir une macro qui permettrait de copier des feuilles d'un classeur contenant des données dans un autre classeur selon certains critères.
Comme exemple, je joins les classeurs source, cible et résultat.
Le nom du classeur cible est quelconque. Aucun nom doit être assigné au classeur cible. Il constitue uniquement le classeur actif (ouvert) à partir duquel la macro sera exécutée.
Le nombre de feuilles est variable. La cellule "I3" dans toutes les feuilles contient une donnée quelconque (différente de "X", cellule non vide). Une donnée de référence quelconque et distincte est contenue dans la cellule "D9" dans chacune des feuilles du classeur.
Le nom du classeur source est quelconque. Aucun nom doit être assigné au classeur source. Le nombre de feuilles est variable. La cellule "I17" dans toutes les feuilles contient une donnée quelconque (différente de "X", cellule non vide). Une donnée de référence distincte est contenue dans la cellule "D9" dans chacune des feuilles du classeur. Le nom de chacune des feuilles est associé à la valeur de référence ("D9").
Lorsque la macro est exécutée à partir du classeur cible, une boîte de dialogue doit s'ouvrir et nous demander de choisir un classeur source quelconque comme dans l'exemple ci-dessous :
********************************************************************************************************************************
Dim wb As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Title = "Choisir un fichier source quelconque"
.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_Données_classeur_source_vers_classeur_cible(wb)
'
MsgBox "Transferts du fichier " & wb.Name & " effectués"
wb.Close (False)
Next i
End If
End With
Sheets("DE_MODEL").Select
Application.DisplayAlerts = False
' ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End Sub
'
Copier_Données_classeur_source_vers_classeur_cible ()
x
x
x
x
End Sub
********************************************************************************************************************************
La macro doit comparer les valeurs de référence en "D9" dans les classeurs cible et source et copier uniquement les feuilles du classeur source qui sont identiques aux valeurs de référence en "D9" du classeur cible.
Dans le classeur cible, seules les feuilles dont les cellules en "D9" et "I3" qui sont "non vides" seront comparées avec celles du classeur source. Dans le classeur source, seules les feuilles dont les cellules en "D9" et "I17" qui sont "non vides" seront comparées avec celles du classeur cible. Ces différents tests dans les classeurs cible et source sont nécessaires car ces classeurs peuvent contenir d'autres types de feuilles que celles représentées dans les classeurs joints.
Lorsque que les feuilles appropriées du classeur source seront copiées dans le classeur cible, le classeur source doit être fermé. Seul le classeur cible doit demeuré ouvert.
A titre d'exemple, le résultat de cette comparaison et la copie des feuilles donc les valeurs sont identiques en "D9" est représenté dans le fichier "Classeur résultat" ci-joint. Le classeur résultat est le classeur cible. Le classeur résultat ne représente pas un nouveau classeur qui devra être créé.
En résumé, les classeurs cible et source peuvent avoir des noms quelconque. Le nombre de feuilles dans ces classeurs est variable. Dans le classeur cible, seules les feuilles avec des données dans les cellules "D9" et "I3" seront prises en compte. Dans le classeur source, seules les feuilles avec des données dans les cellules "D9" et "I17" seront prises en compte. Les valeurs de référence dans les 2 classeurs sont situées dans la cellule "D9". Seules les feuilles dont les valeurs de référence identiques seront copiées dans le classeur cible.
Si vous avez des questions, n'hésitez pas à me contacter.
Merci à l'avance pour votre précieuse collaboration,
Renaud22
