Copier coller colonnes sous conditions avec mise à jour auto
Bonjour
Je viens vers vous pour un peu d'aide concernant la création d'une macro. Voilà ce que je souhaiterais faire. J'ai un fichier excel nommé "classeur source" contenant un certain nombre de feuilles, toutes faites sur le même modèle : Une première colonne A contenant des chiffres, une deuxième colonne B contenant du texte et une série de colonnes (à partir de la colonne C) contenant des données, notamment en première ligne des prénoms.
Je voudrais que la macro fasse les choses suivantes :
- créer un fichier excel sur le modèle du classeur source ( même nombre de feuilles et même nom de feuille), contenant les colonnes A et B de chaque feuille du classeur source, ainsi que toutes les colonnes contenant le même prénom (par exemple Mya sur la première ligne).
- que le nom du classeur créé contienne le prénom en question par exemple "classeur élève Mya"
- qu'il soit créé autant de fichiers que de prénom différents sur la ligne 1
- si le fichier existe déjà qu'il soit juste mis à jour
- si je mets à jour le classeur source, les classeurs élèves se mettent aussi à jour.
Je vous joins le "classeur source" ainsi que un "classeur élève".
Merci beaucoup pour votre aide et bonnes fêtes de fin d'année.
Macgivre67
Bonsoir McGivre, bonsoir le forum,
le code ci-dessous crée ou remplace les onglets des élèves. Je n'ai pas fait de mise à jour automatique mais il s'exécute chaque fois que tu fermes le classeur source. Comme ça tu es sûr d'avoir toujours les données à jour...
Le code se trouve dans le composant ThisWorkbook :
Private Sub Workbook_BeforeClose(Cancel As Boolean) 'avant de fermet le classseur
Module1.Macro1 'lance la procédure [Macro1] du module [Module 1]
MsgBox "Données traitées !" 'message de fin
End SubEt dans le Module 1:
Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim NOD As Byte 'déclare la variable NOD (Nombre d'Onglets par Défaut)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim LE As Range 'déclare la variable LE (Liste des Élèves)
Dim DC As Integer 'déclare la variable DC (Dernière Colonne)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim F As String 'déclare la variable F (Fichier)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim J As Integer 'déclare la variable J (incrément)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim COL As Integer 'déclare la variable COL (COLonne)
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Application.DisplayAlerts = False 'empêche les messages d'Excel
Set CS = ThisWorkbook 'définit le classeur source CS
NOD = Application.SheetsInNewWorkbook 'récupère le nombre d'onglets par défaut NOD
CA = CS.Path & "\" 'définit le chemin d'accès CA
Set OS = CS.Worksheets(1) 'définit l'onglet source OS (ici le premier onglet du classeur source)
DC = OS.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée DC de la ligne 1 de l'onglet OS
Set LE = OS.Range(OS.Cells(1, "C"), OS.Cells(1, DC)) 'définit la liste des élèves LE
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each CEL In LE 'boucle sur toutes les cellules CEL de la liste LE
D(CEL.Value) = "" 'alimente le dictionnaire D
Next CEL 'prochaine cellule de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des élève sans doublon
Application.SheetsInNewWorkbook = 1 'définit le nombre d'onglets par défaut à la création d'un nouveau classeur
For I = 0 To UBound(TMP) 'boucle 1 : sur tous les élèves du tableau temporaire TMP
F = Dir(CA & TMP(I) & "xlsx") 'définit le fichier portant le nom de TMP(I) ayant CA comme chemin d'accès
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CD = Workbooks.Open(CA & F) 'définit le classeur destination CD en l'ouvrant (génère une erreur s'il n'existe pas)
If Err = 0 Then 'condition : si aucune erreur n'a été générée
For J = 2 To 4 'boucle de 2 à 4
CD.Worksheets(J).Delete 'supprime l'onglet de la boucle
Next J 'prochain onglet de la boucle
Else 'sinon (si une erreur a été générée)
Err = 0 'annule l'erreur
Set CD = Workbooks.Add 'ajoute un classeur vierge
CD.SaveAs CA & TMP(I), 51 'enregistre ce classeur avec le nom de l'élève
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
For Each O In CS.Worksheets 'boucle 2 : sur tous les onglets O du classeur source
O.Copy after:=CD.Worksheets(Sheets.Count) 'copy l'onglet O dans le classeur destination en dernière position
Set OD = CD.ActiveSheet 'définit l'onglet destination OD
For COL = DC To 3 Step -1 'boucle 3 : inversée de la dernìere colonne DL à la colonne 3
'si la valeur de la cellule en ligne 1 de la boucle n'est pas égale à TMP(I), supprime la colonne
If Not OD.Cells(1, COL).Value = TMP(I) Then OD.Columns(COL).Delete
Next COL 'prochaine colonne de la boucle 3
Next O 'prochain onglet de la boucle 2
CD.Worksheets(1).Delete 'supprime le premier onglet du classeur destination CD
CD.Worksheets(1).Activate 'active le premier onglet du claseur destination
CD.Worksheets(1).Range("A1").Select 'sélectionne la cellule A1 du premier onglet su classeur destination
CD.Close True 'ferme le classeur destination en enregistrant les modifications
Next I 'prochain élève de la boucle 1
Application.DisplayAlerts = True 'autorise les messages d'Excel
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
Application.SheetsInNewWorkbook = NOD 'remet le nombre d'onglets par défaut NOD comme il était avant la macro
OS.Range("A1").Select 'sélectionne la cellule A1 de l'onglet source OS
End SubLe fichier :