Garder format et mise en page avec un copier-coller

Version imprimable

Voir 40 message(s) de cette discussion en une page

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:

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...

bonsoir,

et si tu essai en enlevant select et activate :
Code:

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:

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

06/11/2008, 09h15
fribelle

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 ?
06/11/2008, 09h35
decondelite

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... :roll:
06/11/2008, 10h02
fribelle

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.

Bonjour,

Essaie avec ce bout de code:

Code:

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

06/11/2008, 13h53
fribelle

:cry: Ca ne marche pas non plus
Et ça ne comprend pas " xlColumnWidths "
Merci quand même... D'autres idées ?
06/11/2008, 14h22
peaceandloveman01

Citation:

Envoyé par fribelle

:cry: 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é :oops:

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

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.

06/11/2008, 15h31
peaceandloveman01
Le probleme vient de:
Code:

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... :oops:

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:

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

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:

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:

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 :roll:

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
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

07/11/2008, 10h42
fring

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:

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
07/11/2008, 11h20
fribelle

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.

Citation:

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:

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 ;)
.

10/11/2008, 09h42
fribelle

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...
10/11/2008, 09h48
JackOuYA

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 ?
10/11/2008, 11h55
fribelle

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...
10/11/2008, 12h25
JackOuYA

il manque quoi dans ton format ..? moi j'ai la couleur, la police, la largeur des colonnes..,!
10/11/2008, 13h26
fribelle

ah bon ? Bah moi, pas du tout! Aucune des cellules n'est à la bonne taille. Les polices ça va !

Voir 40 message(s) de cette discussion en une page