Macro Copier coller

**sophang** · 03/03/2015, 09h20

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

**Thautheme** · 03/03/2015, 12h09

Bonjour Sophang, bonjour le forum,

Je n'ai pas ouvert tes fichiers mais juste regardé le code. C'est cette partie du code qui transforme formules en valeurs :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Range("A2:J77").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

Ensuite la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Macro").Select

pour moi ne sert à rien...

Le code comme je l'aurais écrit (si j'ai bien tout compris) :

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
Sub Mise_à_jour_REPORTING()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CC As Workbook 'déclare la variable CC (Classeur Cible)
Dim OC As Worksheet 'déclare la variable OC (Onglet Cible)
Dim JourJ As Integer
Dim PL As Range 'déclare la variable PL (PLage)
Dim PremLigne As Long
Dim DerLigne As Long
Dim I As Byte
 
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Sheets("Tréso") 'définit l'onglet source OC
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la aligne suivante)
Set CC = Workbooks("REPORTING.xlsx") 'définit le classeur cible CC (génère une erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Workbooks.Open Filename:="C:\Test\REPORTING.xlsx" 'ouvre le fichier "REPORTING.xlsx"
    Set CC = ActiveWorkbook 'définit le classeur cible CC
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OC = CC.Sheets("Tréso") 'définit l'onglet cible OC
JourJ = Weekday(OS.Range("A2"), 2) 'définit la variable jourJ
Set PL = OS.Range("A2:L" & OS.Cells(Application.Rows.Count, 1).End(xlUp).Row) 'définit la palge PL
'copie la plage PL et la colle dans la première cellule vide de la colonne A de l'onglet OC
PL.Copy OC.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
If JourJ = 5 Then 'condition si le JurJ est égal à 5
    For I = 1 To 2 'boucle de 1 à 2
        PremLigne = OC.Cells(Application.Rows.Count, 1).End(xlUp).Row + 1 'définit la variable PremLigne
        DerLigne = PremLigne + PL.Rows.Count - 1 'définit la variable DerLigne
        PL.Copy OC.Cells(PremLigne, 1) 'copy la plage PL dans la cellule ligne PremLigne colonne A de l'onglet OC
        With OC.Cells(PremLigne, 1) 'prend en compte la cellule ligne PremLigne colonne A de l'onglet OC
            .Value = .Value + I 'définit la valeur de la cellue
            'définit le remplissage automatique
            .AutoFill Destination:=OC.Range(OC.Cells(PremLigne, 1), OC.Cells(DerLigne, 1)), Type:=xlFillCopy
        End With 'fin de la prise en compte de la cellule ligne PremLigne colonne A de l'onglet OC
    Next I 'prochaine valeur de la boucle
End If 'fin de la condition
End Sub

**sophang** · 03/03/2015, 12h59

Bonjour Thautheme,

Merci pour ta réponse, j'ai essayé ton code, et j'ai ce message à la ligne 23:
"Erreur d'exécution '1004': Erreur définie par l'application ou par l'objet"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set PL = OS.Range("A2:L" & OS.Cells(Application.Rows.Count, 1).End(xlUp).Row) 'définit la palge PL

**Thautheme** · 03/03/2015, 14h04

Bonjour Sophang, bonjour le forum,

En effet, en testant sur tes fichiers ça plante ! Pourtant ça ne devrait pas... J'ai donc remanié le code et j'en ai profité pour ne plus faire un copier/coller mais un copier/coller les valeurs...

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
Sub Mise_à_jour_REPORTING()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CC As Workbook 'déclare la variable CC (Classeur Cible)
Dim OC As Worksheet 'déclare la variable OC (Onglet Cible)
Dim JourJ As Integer
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim PremLigne As Long
Dim DerLigne As Long
Dim I As Byte
 
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Sheets("Tréso") 'définit l'onglet source OC
DL = OS.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet OS
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la aligne suivante)
Set CC = Workbooks("REPORTING.xlsx") 'définit le classeur cible CC (génère une erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Workbooks.Open Filename:="C:\Test\REPORTING.xlsx" 'ouvre le fichier "REPORTING.xlsx"
    Set CC = ActiveWorkbook 'définit le classeur cible CC
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OC = CC.Sheets("Tréso") 'définit l'onglet cible OC
JourJ = Weekday(OS.Range("A2"), 2) 'définit la variable jourJ
Set PL = OS.Range("A2:L" & DL) 'définit la plage PL
PL.Copy 'copie la plage PL
'colle les valeursdans la première cellule vide de la colonne A de l'onglet OC
OC.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
If JourJ = 5 Then 'condition si le JourJ est égal à 5
    For I = 1 To 2 'boucle de 1 à 2
        PremLigne = OC.Cells(Application.Rows.Count, 1).End(xlUp).Row + 1 'définit la variable PremLigne
        DerLigne = PremLigne + PL.Rows.Count - 1 'définit la variable DerLigne
        PL.Copy 'copie la plage PL
        OC.Cells(PremLigne, 1).PasteSpecial (xlPasteValues) 'colle les valeurs dans la cellule ligne PremLigne colonne A de l'onglet OC
        With OC.Cells(PremLigne, 1) 'prend en compte la cellule ligne PremLigne colonne A de l'onglet OC
            .Value = .Value + I 'définit la valeur de la cellue
            'définit le remplissage automatique
            .AutoFill Destination:=OC.Range(OC.Cells(PremLigne, 1), OC.Cells(DerLigne, 1)), Type:=xlFillCopy
        End With 'fin de la prise en compte de la cellule ligne PremLigne colonne A de l'onglet OC
    Next I 'prochaine valeur de la boucle
End If 'fin de la condition
End Sub

**sophang** · 04/03/2015, 10h24

Bonjour,

J'ai essayé ton code, et çà marche à merveille. Il y a des arguments que je ne connaissais même pas. C'est très enrichissant.

Merci encore.

Macro Copier coller [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager