Garder format et mise en page avec un copier-coller

**fribelle** · 05/11/2008, 16h45

Bonjour !

Je me suis renseignée sur internet pour trouver une façon de faire une copie d'un tableau d'un classeur excel et de le coller dans un autre classeur tout en gardant son format d'origine et sa mise en page.
J'ai fait des collages spéciaux mais je n'ai jamais le bon code.
Quelqu'un pourrait-il me faire un exemple de macro simple qui effectue cette action en étant sûr que ça fonctionne ?

Je crois que mon problème c'est que j'ai une macro qui m'ouvre un nouveau classeur et je veux faire mon copier-coller avant qu'elle ne me l'enregistre, et j'ai toujours du mal à appeller ce classeur. Il ne veut pas me l'activer si je ne le mets pas sur la même ligne que l'action que j'éxecute.

Je vous mets un petit bout de ma macro dans lequel j'ai fait un collage simple, mais ce n'est pas ce que je veux. Je dois modifier comment :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
    Windows("monclasseur.xls").Activate
    Sheets("mapage").Select
    Cells.Select
    Selection.Copy
 
'tb_xl est le nom du classeur créé par la macro
 
    tb_xl.ActiveSheet.Range("A1").Activate
 
'le paste suivant est à modifier
    tb_xl.ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWindow.Zoom = 60

Pourquoi je galère...snif...

**JackOuYA** · 05/11/2008, 22h28

bonsoir,

et si tu essai en enlevant select et activate :

Code :

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

1
2
 
Workbooks("monclasseur.xls").Sheets("mapage").Cells.Copy   tb_xl.ActiveSheet.Range("A1")

et si ta macro et dans "monclasseur.xls" , c'est encore mieux ainsi :

Code :

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

1
2
 
ThisWorkbook.Sheets("mapage").Cells.Copy   tb_xl.ActiveSheet.Range("A1")

**fribelle** · 06/11/2008, 09h15

Merci mais pour la copie c'est bon ça marche, c'est pour le collage spécial que j'ai des soucis. La macro telle que je l'ai envoyée me fait bien un copier de "mon classeur" et un coller ds tb_xl mais le tableau ne garde pas sa mise en forme d'origine. Je dois faire comment ?

**decondelite** · 06/11/2008, 09h35

Le collage spécial n'est pas fait pour conserver la mise en forme d'origine: il est même fait pour ne pas la respecter...

**fribelle** · 06/11/2008, 10h02

Qu'est-ce que je suis sensée faire alors ?
Et c'est bizarre que tu dises ça, car le pinceau quand on s'en sert il reproduit la mise en forme et ca s'appelle un collage spécial, non ? J'ai essayé de récupérer son code, mais ça ne fonctionne pas.

**peaceandloveman01** · 06/11/2008, 12h30

Bonjour,

Essaie avec ce bout de code:

Code :

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

1
2
3
4
5
6
Selection.PasteSpecial Paste:=xlColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

Cordialement,

Lyonel

**fribelle** · 06/11/2008, 13h53

Ca ne marche pas non plus
Et ça ne comprend pas " xlColumnWidths "
Merci quand même... D'autres idées ?

**peaceandloveman01** · 06/11/2008, 14h22

Envoyé par fribelle

Ca ne marche pas non plus
Et ça ne comprend pas " xlColumnWidths "
Merci quand même... D'autres idées ?

C'est juste pour conserver également la largeur de la colonne... Histoire de conserver au maximum la mise en forme. Mais si ça ne marche pas je n'ai pas d'autres idées. Désolé

**fribelle** · 06/11/2008, 14h34

Je comprends ce qui ne va pas dans ma macro, mais je ne sais pas résoudre le problème :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Sub Macro2()
'
    Selection.Copy
    Windows("Classeur1").Activate
    Range("F11").Select
   Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
 
End Sub

J'obtiens ce code en reproduisant une mise en forme. Mais j'ai deux classeurs, et il ne veut faire ça que sur le premier si je laisse dans cette mise en forme. Il faudrait que je trouve le moyen de faire ce code en une fois en appellant le classeur que je veux au début (sans passer par select/ selection, qui pose problème).
Vous avez compris mon problème ?
Merci pour votre aide.

**peaceandloveman01** · 06/11/2008, 15h31

Le probleme vient de:

Code :

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

1
2
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

Tu peux surement contourner le problème en enregistrant une macro quand tu fais ta mise en forme. Ainsi tu copy simplement les données dans ton deuxième classeur et fait la mise en forme dans ce même classeur grâce à une macro. En attendant de trouver mieux...

**fring** · 06/11/2008, 19h29

Bonjour,

En supposant que le classeur source et le classeur cible sont ouverts, l'exemple ci-dessous va copier la plage de cellule avec sa mise en forme sans utilisation de Select

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
Sub test()
Dim SHsource As Worksheet, SHcible As Worksheet, x As Integer
Dim PlageSource As Range, CelluleCible As Range, i As Integer
 
Set SHsource = ThisWorkbook.Sheets("Feuil1") '<-- classeur source
Set SHcible = Workbooks("Classeur1").Sheets("Feuil1") '<-- classeur cible
Set PlageSource = SHsource.Range("A1:C10") '<-- plage de cellules à copier
Set CelluleCible = SHcible.Range("F11") '<-- destination (à partir de F11)
 
PlageSource.Copy CelluleCible '<-- copie de la plage
 
'adaptation hauteur des lignes
x = 0
For i = CelluleCible.Row To CelluleCible.Row + PlageSource.Rows.Count
    x = x + 1
    SHcible.Cells(i, 1).RowHeight = PlageSource.Rows(x).RowHeight
Next
 
'adaptation largeur des colonnes
x = 0
For i = CelluleCible.Column To CelluleCible.Column + PlageSource.Columns.Count
    x = x + 1
    SHcible.Cells(1, i).ColumnWidth = PlageSource.Columns(x).ColumnWidth
Next
 
End Sub

**fribelle** · 07/11/2008, 09h47

Oui peaceandloveman01, c'est ce que je ferai si je ne trouve pas mieux. Mais j'aurai préféré que ça me fasse tout d'un coup, car elle va être fréquemment utilisée cette macro.

Merci fring pour le code, je l'ai tenté, mais ça bugue à :

Code :

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

1
2
 
PlageSource.Copy CelluleCible '<-- copie de la plage

"Erreur d'éxécution '1004' : La méthode copy de la classe Range à échoué"

Et à mon avis, c'est l'appel de mon nouveau classeur qu'il ne comprend encore pas :

Code :

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

1
2
 
Set SHcible = tb_xl.ActiveSheet '<-- classeur cible

Peut-être que je devrais publier toute ma macro pour que vous compreniez l'erreur que je fais ? Dites moi si c'est nécessaire.

En tout cas, merci pour votre aide !!

Bon, je la publie de toutes façons, comme ça...
Par contre c'est un peu long

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
Option Explicit 'spécifie que toutes les variables doivent être déclarées
Public tb_zd As String
Public exist_dir, exist_file As String
Public tb_xl As Excel.Application
Public Source As Excel.Workbook
Public OngletSupprime, pth, tb_date, tb_an, tb_mois, pth_sortie As String
Public i, compt, compt2 As Integer
Public f As Object
Dim pole, mois, an As String
Dim msg, titre, Condition As String
 
Sub auto_open()
    'verifie l'existence d'un bouton pour lancer la macro
    'Création du bouton s'il n'existe pas
    For Each f In Application.Toolbars
        Application.StatusBar = f.Name
        If f.Name = "Editer" Then i = 1
    Next
    If i <> 1 Then
        Application.Toolbars.Add ("Editer")
        Application.Toolbars("Editer").ToolbarButtons.Add Button:=210, Before:=2, StatusBar:="Préparation fichier TB"
        'On lui affecte une macro
        Application.Toolbars("Editer").ToolbarButtons(1).OnAction = ThisWorkbook!debut
        Application.Toolbars("Editer").ToolbarButtons(1).Name = "TB_Extraction"
    End If
    With Application.Toolbars("Editer")
        .Visible = True
    End With
End Sub
 
Sub debut() 'Permet de créer le classeur final
 
'Renseignement des champs (pas terrible ces msgbox, à retravailler)
msg = "Ecrivez le mois recherché en majuscules :"
titre = "Choix du mois, de l'année, et du pôle"
Condition = False
mois = InputBox(msg, titre)
If mois <> "" Then
Condition = True
End If
 
msg = "Ecrivez l'année recherchée :"
titre = "Choix du mois, de l'année, et du pôle"
Condition = False
an = InputBox(msg, titre)
If an <> "" Then
Condition = True
End If
 
msg = "Ecrivez le pole recherché (4 chiffres au total) :"
titre = "Choix du mois, de l'année, et du pôle"
Condition = False
pole = InputBox(msg, titre)
If pole <> "" Then
Condition = True
End If
 
 
'mois = "AOUT"
'an = "2008"
'pole = "0010"
 
    'initialise les fichiers et leur chemin d'accès
 
    Application.StatusBar = "Début du module"
 
    'fichier excel contenant la macro principale
    Set Source = Workbooks("SCFI " & pole & " " & mois & " " & an & ".xls")
 
    'repertoire de travail
    pth = Workbooks("SCFI " & pole & " " & mois & " " & an & ".xls").Path + "\"
 
    'initialisation des dates et heures
    tb_an = Year(Now())
    tb_mois = Month(Now())
 
    tb_date = tb_an & "-" & tb_mois
    tb_zd = "tb_zd_" & tb_date & ".xls"
 
    'Création du répertoire de sortie
    exist_dir = Dir(pth & tb_date & "_SCFI " & pole & " " & mois & " " & an, 16)
            If exist_dir = "" Then 'le répertoire pour l'exercice n'existe pas
            MkDir pth & tb_date & "_SCFI " & pole & " " & mois & " " & an 'on le crée
    exist_dir = Dir(pth & tb_date & "_SCFI " & pole & " " & mois & " " & an, 16)
        End If
 
    'ouverture du fichier excel contenant les données
    Set tb_xl = CreateObject("Excel.Application")
    tb_xl.Visible = "true"
    tb_xl.Workbooks.Add
 
    'Suppression des feuilles créées par défaut : on n'en garde qu'une seule
    compt = tb_xl.Sheets.Count
    tb_xl.Application.DisplayAlerts = False
        For i = 1 To tb_xl.Sheets.Count - 1
            OngletSupprime = tb_xl.Sheets(i).Name
            tb_xl.Sheets(OngletSupprime).Delete
        Next i
    tb_xl.Application.DisplayAlerts = True
 
Call tab_edit
End Sub
 
Sub tab_edit()
 
' Permet de copier les données dans le classeur initial
 
 
Application.DisplayAlerts = False
    Windows("Classeur1").Activate
For i = 2 To Sheets.Count
 
    Windows("Classeur1").Activate
    Sheets(Sheets(i).Name).Select
    Cells.Select
    Selection.Copy
    Windows("SCFI " & pole & " " & mois & " " & an & ".xls").Activate
    Sheets("RECUP SCFI " & pole).Select
    Cells.Select
    Range("E6").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("E6").Select
    Call Onglet
 
Next i
tb_xl.Application.DisplayAlerts = False
tb_xl.Sheets(1).Delete
tb_xl.Application.DisplayAlerts = True
Application.DisplayAlerts = True
Call sauvegarde
 
End Sub
Sub Onglet()
 
    'Initialisation de l'onglet de page de garde
Dim NomOnglet
NomOnglet = "true"
 
    NomOnglet = Source.Sheets(pole).Range("A1").Value
        tb_xl.Sheets.Add after:=tb_xl.Sheets(1)
        tb_xl.ActiveSheet.Name = [NomOnglet]
 
Call test
 
End Sub
Sub copie()
'Permet de copier le tableau de bord correspondant dans le nouveau classeur
 
    Windows("SCFI " & pole & " " & mois & " " & an & ".xls").Activate
    Sheets(pole).Select
    Cells.Select
    Selection.Copy
    tb_xl.ActiveSheet.Range("A1").Activate
    tb_xl.ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWindow.Zoom = 60
 
End Sub
 
'autre test de copie
Sub test()
Dim SHsource As Worksheet, SHcible As Worksheet, x As Integer
Dim PlageSource As Range, CelluleCible As Range, i As Integer
 
Set SHsource = Workbooks("SCFI " & pole & " " & mois & " " & an & ".xls").Sheets(pole) '<-- classeur source
Set SHcible = tb_xl.ActiveSheet '<-- classeur cible
Set PlageSource = SHsource.Range("A1:P52") '<-- plage de cellules à copier
Set CelluleCible = SHcible.Range("A1") '<-- destination (à partir de A1)
 
PlageSource.Copy CelluleCible '<-- copie de la plage
 
'adaptation hauteur des lignes
x = 0
For i = CelluleCible.Row To CelluleCible.Row + PlageSource.Rows.Count
    x = x + 1
    SHcible.Cells(i, 1).RowHeight = PlageSource.Rows(x).RowHeight
Next
 
'adaptation largeur des colonnes
x = 0
For i = CelluleCible.Column To CelluleCible.Column + PlageSource.Columns.Count
    x = x + 1
    SHcible.Cells(1, i).ColumnWidth = PlageSource.Columns(x).ColumnWidth
Next
 
End Sub
 
Sub sauvegarde()
 
pth_sortie = pth & exist_dir & "\" & tb_zd
Application.StatusBar = "Sortie : " & tb_zd & " " & pth_sortie
tb_xl.ActiveWorkbook.SaveAs pth_sortie
 
'tb_xl.ActiveWorkbook.Close
'tb_xl.Application.Quit
Application.StatusBar = "Fin de chargement"
 
 
Windows("SCFI " & pole & " " & mois & " " & an & ".xls").Application.DisplayAlerts = False
Windows("SCFI " & pole & " " & mois & " " & an & ".xls").Application.Quit
 
End Sub

**fring** · 07/11/2008, 10h42

Re,

A quoi te sert ceci Public tb_xl As Excel.Application ?
Tu n'exécutes pas la macro au départ d'Excel ?

Pour la feuille cible, si celle-ci se trouve dans le classeur contenant la macro

Code :

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

Set SHcible = ThisWorkbook.ActiveSheet

Il faut, dans la mesure du possible, éviter d'utiliser les ActiveCell, ActiveSheet et ActiveMachin en tous genres, ce qui un jour ou l'autre provoquera un bug parce que cela ne sera pas la bonne feuille ou la bonne cellule qui sera active au moment de l'exécution de la macro.

Cdlt

**fribelle** · 07/11/2008, 11h20

Bah, justement, tb_xl c'est mon nouveau classeur, créé par la macro, et donc non ma feuille cible n'est pas dans le classeur contenant ma macro: elle est dans le nouveau classeur.
Et je n'ai pas touvé le moyen d'éviter les active sheet car dans ma macro je créé un classeur et je fais des boucles sur toutes les pages pour y rajouter des tableaux. En + je renomme les pages en fonction de références sur mon premier classeur, donc je ne vois pas comment les appeller autrement qu'avec activesheet.

**fring** · 07/11/2008, 11h56

Envoyé par fribelle

Bah, justement, tb_xl c'est mon nouveau classeur

euuh...j'ai un peu du mal à suivre, tu déclares tb_xl comme l'application Excel et pas comme Classeur (Workbook) ?

Un exemple de création d'un nouveau classeur ne contenant qu'une seule feuille (inutile d'en créer 10 et d'en supprimer 9) avec copie d'une plage de cellules

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
Sub test()
Dim tb_xl As Workbook, NbrFL As Byte
 
NbrFL = Application.SheetsInNewWorkbook '<-- mémorisation du nombre de feuilles pré-programmé
 
Application.SheetsInNewWorkbook = 1 '<-- modification du paramètre "nombre de feuilles dans nouveau classeur"
Set tb_xl = Workbooks.Add '<-- création nouveau classeur avec une seule feuille
 
With tb_xl
    .Sheets(1).Name = "Toto" '<-- nom de la feuille
    .SaveAs "D:\Temp\Classeur_test.xls" '<-- sauvegarde du classeur
End With
 
'copie de la plage A1:A10 depuis ce classeur vers le nouveau classeur
ThisWorkbook.Sheets("Feuil1").Range("A1:A10").Copy tb_xl.Sheets(1).Range("A1")
 
tb_xl.Close True '<-- sauvegarde et fermeture du nouveau classeur
 
Application.SheetsInNewWorkbook = NbrFL '<-- remise du paramètre pré-programmé
 
End Sub

PS: il n'y a toujours pas de Select ou d'ActiveMachin dans le code

.

**fribelle** · 10/11/2008, 09h42

Si je ne mets pas "Application", ça ne fonctionne pas. C'est bien le truc des feuilles automatiquement à 1, merci beaucoup !
Pour le reste, je pense que je vais me débrouiller avec une deuxième macro... C'est pas terrible mais rien d'autre ne fonctionne...

**JackOuYA** · 10/11/2008, 09h48

bonjour,

juste une question,pour que je comprenne.., que te manque t'il dans la copie de ta feuille lorsque tu utilise le code, que j'ai placé en réponse 2 de ce post ?

**fribelle** · 10/11/2008, 11h55

Bien, avec le code que tu m'as donné, je n'ai qu'une simple copie, mais le format n'est pas le même. J'ai été obligé de faire une deuxième macro. Mais bon, elle fonctionne. C'est juste long à faire et j'aurai aimé automatiser le + possible...