Discussion :

[Avrilae]

Bonjour,

J'ai un fichier excel que j'envoie à des services Ressources Humaines pour qu'ils travaillent sur les augmentation de salaire. L'idée est qu'ils puissent redécouper le fichier par Responsable Ressources Humaines : RRH ou par Manager (boutons accessibles depuis l'onglet "Découpage").
Le découpage fonctionne très bien (j'ai bidouillé, ça ne doit pas être très académique mais cela fonctionne).

En revanche je suis confrontée à 2 soucis :
- est_il possible de conserver les formules qui apparaissent dans le corps de la feuille Données (formules sans lien avec d'autres feuilles) : c'est vraiment ma priorité puisque je souhaite que ce fichier puisse etre envoyé puis redécoupé par les destinataires tout en conservant les formules (j'aimerai que lorsqu'ils saisissent une augmentation, le nouveau salaire soit calculé).
Pour le moment seules les formules sur les 15 premières lignes sont conservées, mais les données découpées perdent leurs formules.
- est_il possible de conserver le format des nombre (nombre de décimales, séparateur de milliers, format, etc...), la largeur des colonnes, etc... ?

Voici le code que je souhaiterai modifier + fichier joint


Trame 2019 Test2.xlsm

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
44
45
46
47
48
Sub DécoupageRRH()
    Dim aa, rh, ln, RRH(), plgET As Range, chD$, k%, n&, i&, d As Object, wsME As Worksheet, wsDATA As Worksheet, wsDECOUP As Worksheet
            With ThisWorkbook
        chD = .Path & "\"
        Set wsME = .Worksheets("Mode d'emploi")
        Set wsDATA = .Worksheets("Données")
        Set wsDECOUP = .Worksheets("Découpage fichiers")
    End With
 
    With wsDATA
        i = .Range("A" & .Rows.Count).End(xlUp).Row
        If i <= 15 Then Exit Sub
        k = .Cells.SpecialCells(xlCellTypeLastCell).Column
        aa = .Range("A15:A" & i).Resize(, k).Value
        Set plgET = .Range("A1:A14").Resize(, k)
    End With
    chD = ThisWorkbook.Path & "\"
        Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(aa)
        d(aa(i, 1)) = d(aa(i, 1)) & ";" & i
    Next i
 
    Application.ScreenUpdating = False
    For Each rh In d.keys
        ln = Split(d(rh), ";"): n = UBound(ln)
        ReDim RRH(1 To n)
        For i = 1 To n
            RRH(i) = WorksheetFunction.Index(aa, CInt(ln(i)), 0)
        Next i
 
        With Workbooks.Add(xlWBATWorksheet)
             .Worksheets(1).Name = ("Données")
            With .Worksheets(1)
                            plgET.Copy .Range("A1")
                With .Range("A15").Resize(n, k)
                    .Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(RRH))
                    .Borders.Weight = xlThin
                End With
            End With
            wsME.Copy before:=.Worksheets(1)
              wsDECOUP.Copy before:=.Worksheets(1)
            .SaveAs chD & rh & ".xlsx"
            .Close
        End With
    Next rh
 
        MsgBox "Découpage du fichier terminé !"
End Sub

D'avance, je vous remercie pour votre aide !
Avrilae

[jpvba]

Bonjour Avrilae,


Il faudrait modifier votre message et utiliser dans les "boutons outils le" # qui permet de mettre une balise au niveau de votre code.


Également la plupart des gens du forum n'ouvrent pas de fichier contenant des macros, donc utilisé le format xlsx

[Avrilae]

Bonjour,

Entre temps j'ai réussi à repondre à ma première question à savoir comment copier mes formules.
Ci-après le code modifié et je suis les conseils de Jpvba et insère un fichier .xlsx

Trame 2019 Test3.xlsx


En revanche je continue de bloquer sur un point : ma macro me permet de découper mon fichier tout en conservant mes formules MAIS je n'arrive pas à conserver le format. J'aimerais donc insérer un code me permettant :
1 : sélectionner l'ensemble de ma feuille de calcul initiale
2 : utiliser la fonction "petit balai" pour reproduire la mise en forme sur les classeurs nouvellement crées (l'idée étant de conserver les formats de nombre, etc...)

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
44
45
46
47
48
Sub DécoupageRRH()
    Dim aa, rh, ln, RRH(), plgET As Range, chD$, k%, n&, i&, d As Object, wsME As Worksheet, wsDATA As Worksheet, wsDECOUP As Worksheet
            With ThisWorkbook
        chD = .Path & "\"
        Set wsME = .Worksheets("Mode d'emploi")
        Set wsDATA = .Worksheets("Données")
        Set wsDECOUP = .Worksheets("Découpage fichiers")
    End With
 
    With wsDATA
        i = .Range("A" & .Rows.Count).End(xlUp).Row
        If i <= 15 Then Exit Sub
        k = .Cells.SpecialCells(xlCellTypeLastCell).Column
        aa = .Range("A15:A" & i).Resize(, k).FormulaR1C1
        Set plgET = .Range("A1:A14").Resize(, k)
    End With
    chD = ThisWorkbook.Path & "\"
        Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(aa)
        d(aa(i, 1)) = d(aa(i, 1)) & ";" & i
    Next i
 
    Application.ScreenUpdating = False
    For Each rh In d.keys
        ln = Split(d(rh), ";"): n = UBound(ln)
        ReDim RRH(1 To n)
        For i = 1 To n
            RRH(i) = WorksheetFunction.Index(aa, CInt(ln(i)), 0)
        Next i
 
        With Workbooks.Add(xlWBATWorksheet)
             .Worksheets(1).Name = ("Données")
            With .Worksheets(1)
                            plgET.Copy .Range("A1")
                With .Range("A15").Resize(n, k)
                    .Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(RRH))
                    .Borders.Weight = xlThin
                End With
            End With
            wsME.Copy before:=.Worksheets(1)
              wsDECOUP.Copy before:=.Worksheets(1)
            .SaveAs chD & rh & ".xlsx"
            .Close
        End With
    Next rh
 
        MsgBox "Découpage du fichier terminé !"
End Sub

D'avance, merci à vous

[jpvba]

Bonjour cher amis,


Afin de conserver la mise en forme de ta cellule, il faut utilisé pastespecial

lire ceci

https://docs.microsoft.com/en-us/off...el.xlpastetype


tu va avoir une tres tres bonne piste afin de résoudre ce problème

[Avrilae]

Bonjour,

Merci pour cette réponse malheureusement je n'arrive pas à intégrer le paste dans mon code, je ne sais pas où l'intégrer exactement ni comment faire référence à mon classuer source ainsi qu'à mon classeur nouvellement créee.

Si quelqu'un peut m'expliquer, je suis preneuse de toute aide !

Avrilae

[jpvba]

Bonjour Avrilae,


Je vois 2 possibilités afin de remédier a la situation. Faire la méthode copier/collage spécial afin de transférer tes informations de la feuilles source a la feuille cible au lieu d'une partie de ton code.


La seconde méthode serais de copier totalement ta feuille source et la renommer et ensuite faire les modification voulus.


Les 2 méthodes te permettra de conserver les mises en formes