Discussion :

[sophang]

Bonjour à tous,



La macro suivante permet d’exporter les MONTANTS (colonne J) de la feuille Tréso du fichier DONNEES à la dernière ligne du fichier REPORTING.
Le problème, c’est qu’après l’export, je ne retrouve plus les formules qu’il y avait dans le fichier DONNEES à la feuille Tréso de la colonne J.

Comment faire pour garder ces formules ?
En vous remerciant par avance de votre aide.

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
Sub Mise_à_jour_REPORTING()
 
Workbooks.Open Filename:="C:\Test\REPORTING.xlsx"
 
Windows("DONNEES.xls").Activate
 
Sheets("Tréso").Select
    Range("A2:J77").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Macro").Select
 
 
Dim WsS As Worksheet, WsC As Worksheet
Dim JourJ As Integer, DerJour As Integer
Dim PremLigne As Long, DerLigne As Long
Dim i As Byte
Dim PlageàCopier As Range
    Set WsS = ThisWorkbook.Worksheets("Tréso") 'Classeur Source (DONNEES.xls)
    Set WsC = Workbooks("REPORTING.xlsx").Worksheets("Tréso") 'Classeur Cible
    'On dédertmine la date du jour indiqué en A2
    JourJ = Weekday(WsS.Range("A2"), 2)
    'On effectue la copie de A2 à J77
    Set PlageàCopier = WsS.Range("A2:L" & WsS.Range("A" & Rows.Count).End(xlUp).Row)
    PlageàCopier.Copy WsC.Range("A" & WsC.Rows.Count).End(xlUp).Offset(1)
    ''Si on est dans le cas où le jour en A2 est un vendredi
    'et le dernier jour indiqué en colonne A (avant copie) est un jeudi
    If JourJ = 5 Then
        For i = 1 To 2
            PremLigne = WsC.Range("A" & Rows.Count).End(xlUp).Row + 1
            DerLigne = PremLigne + PlageàCopier.Rows.Count - 1
            PlageàCopier.Copy WsC.Range("A" & PremLigne)
            With WsC.Range("A" & PremLigne)
                .Value = .Value + i
                .AutoFill Destination:=WsC.Range("A" & PremLigne & ":A" & DerLigne), Type:=xlFillCopy
            End With
        Next i
    End If
    Set PlageàCopier = Nothing: Set WsC = Nothing: Set WsS = Nothing
    Application.CutCopyMode = False
 
 
 
End Sub