Bonjour,

Je viens à vous car mon chef me demande de faire une macro pour excel et je n'y connais rien (c'est la première fois que je touche à de la macro sous excel et au VBA). J'essaie de créer un bouton "Dispatch" qui permet permet d’éclater les données d'une feuille en autant de fichier qu'il y a d’occurrence dans une colonne et à inserer dans le dit fichier toutes les lignes qui contiennent cette occurence. Jusque là "facile". j'ai trouvé un petit projet qui m'a bien guidé.

Ma question porte sur une colonne qui contient une formule. Dans le dit tableau il y a les semaines et chaque semaine une ressource doit saisir dans son fichier le temps consacré à la tache (colonne H à BH). Une colonne (G) contient la formule qui m'ajoute le temps de chaque semaine.

Mais le souci est que lors de mon dispatch, je transfere dans le fichier créé la colonne G contient le temps dans ma source initiale (0 donc) et non la formule a appliquer sur les cellules de mon tableau de destination...

Je vous joins ici mon code :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Option Explicit
Public critere%
 
Sub dispatcher()
Dim Tbl As Variant, data As Variant, I%
Dim dico1 As Object, cle1 As Variant, result1 As Variant
Dim wb As Excel.Workbook
Dim MonRepertoire, Repertoire As FileDialog, racine As String
Dim colonne$
 
    'colonne = Application.InputBox("Entrez la colonne servant de critère de dispatching : ", "Saisie en texte (i.e : A B ...)", Type:=2)
    'critere = ActiveSheet.Columns(colonne).Column
    UserForm1.Show
    If critere = 0 Then Exit Sub
 
    racine = Split(ThisWorkbook.Name, ".")(0)
 
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    MonRepertoire = Repertoire.SelectedItems(1)
 
    data = Cells(Rows.Count, 1).End(xlUp).CurrentRegion
 
    Set dico1 = CreateObject("Scripting.Dictionary")
    For I = LBound(data) + 1 To UBound(data) ' hors en-tête
        dico1(data(I, critere)) = ""
    Next
 
    Application.ScreenUpdating = False
    For Each cle1 In dico1.Keys
        result1 = filtreArray(data, critere, cle1)
        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Model.xlsx")
        wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(result1, 1), UBound(result1, 2)) = result1
        wb.SaveAs (MonRepertoire & "\" & racine & "_" & cle1 & ".xlsx")
        wb.Close
        Set wb = Nothing
    Next
    Application.ScreenUpdating = True
 
    MsgBox "Terminé, fichiers sauvegardés sous """ & MonRepertoire & "\" & """ !"
End Sub
Voici qq données (fichier source simplifié)
Ligne 4 (en-tetes) : A: Taches ; F : Ressources; G : Total d'heure, H : Semaine 1, I : Semaine 2 ....BH : Semaine 53
Ligne 5 : Tache 01; Alpha; =SOMME(H5:BH5); (0partout apres)
Ligne 6 : Tache 02; Alpha; =SOMME(H6:BH6); (0Partout apres)
Ligne 7 : tache 03; Beta; =SOMME(H7:BH7)
Ligne 8 : Tache 04; Alpha; =SOMME(H8:BH8)

Fichier destination attendu Alpha.xlsx:
Ligne 4 : A: Taches ; F : Ressources; G : Total d'heure, H : Semaine 1, I : Semaine 2 (en tetes)....BH : Semaine 53
Ligne 5 : Tache 01; Alpha; =SOMME(H5:BH5); (0partout apres)
Ligne 6 : Tache 02; Alpha; =SOMME(H6:BH6); (0Partout apres)
Ligne 7 : Tache 04; Alpha; =SOMME(H7:BH7)
(et quand j'insere 2 en colonne H4 et 28 en L4 je veux par la suite avoir G4 = 30)


Ma question est donc : Comment faire pour que le contenu de ma cellule G de mon fichier de destination contienne la formule à appliquer sur les colonne de la feuille créée par ma macro de Dispatch ? et surtout où l’insérer dans le code présenté.

merci de votre aide.

Nid4mail