Formule à exporter via macro
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:
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
