VB Excel Copier/Coller

**discus23** · 29/07/2009, 14h22

Bonjour,

J'aimerais avoir une précision pour améliorer l'allure de mon code.

Je cherche à copier une plage de cellule d'un classeur et à la coller ensuite dans un autre classeur.

Pour l'instant, je fais comme suit:

Code :

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

1
2
3
4
5
6
7
8
 
Workbooks(wk_out).Activate
Worksheets("feuil1").Range("B1:G1", Selection.End(xlDown)).Copy
 
Workbooks(wk_new).Activate
Worksheets("feuil2").Select
Range("C2").Select
ActiveSheet.Paste

Mais je n'arrive pas à regrouper la partie "collage" comme j'ai regroupé la partie "copiage".

Ce code fonctionne, mais j'aurais aimé savoir si il y avait la possibilité de faire plus court?...D'autant plus que j'ai parfois plusieurs plages du classeur 1 à coller dans le classeur 2, et qu'entre chaque plage je repasse par un WorkBooks.Activate...

Tous les avis sont les bienvenus!

Merci

**Mikaz** · 29/07/2009, 14h42

Bonjour,

A part regrouper comme ca, je ne sais pas si c'est possible :

Code :

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

1
2
3
4
5
Workbooks(wk_out).Worksheets("feuil1").Range("B1:G1", Selection.End(xlDown)).Select
Selection.Copy
 
Workbooks(wk_new).Worksheets("feuil2").Range("C2").Select
ActiveSheet.Paste

Et sa mais vraiment sans conviction

Code :

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

Workbooks(wk_out).Worksheets("feuil1").Range("B1:G1", Selection.End(xlDown)).Copy

**Gorfael** · 29/07/2009, 14h44

Salut discus23 et le forum
Effectivement, utiliser des select et activate n'est presque jamais une bonne solution

Code :

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

Workbooks(wk_out).sheets("feuil1").Range([B1:G1],[B1:G1].End(xlDown)).Copy Workbooks(wk_new).sheets("feuil2").[C2]

J'ai juste un doute sur le code fourni :
[B1:G1].End(xlDown)) est équivalent à [B1].End(xlDown))
Donc, si colonne G > colonne B on aura une perte de données.
A+

**discus23** · 29/07/2009, 14h52

Merci pour vos réponses.

J'ai testé ta ligne de code Gorfael car il me semblait bien que ce n'était pas le top d'utiliser select notamment, mais elle ne marche pas chez moi... Je ne vois pas à quoi cela peut être dû

**Krovax** · 29/07/2009, 15h01

Si ca ne marche pas c'est pour une raison très simple. Ca ne peux pas marcher! Ca n'a pas de pied
Alors si tu essayé d'expliquer ce qui ne fonctionne pas (l'erreur qui est renvoyé) tu es sur que les deux classeur sont bien ouvert qu'il n'y a pas de problème dans les noms des classeur et des onglets

**discus23** · 29/07/2009, 15h11

Oui c'est vrai que mon dernier post manque un peu d'explication ^^

Alors, en fait je vais devoir faire cette manip sur beaucoup de fichier, donc au départ, je demande à l'utilisateur de choisir les fichiers en questions, fichier que je stocke dans des variables (wk_in, wk_out, wk_new).

Voici une partie de mon code, qui ne traite qu'avec wk_out et wk_new.

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
 
Public Sub newFormat()
 
 
Dim wk_in As Variant      'JE_entrée
Dim wk_out As Variant     'JE_sortie
Dim wk_new As Variant     'JE_new
 
Dim N As Integer
Dim I As Integer
 
Dim A As Object
Dim B As Object
 
 
 
'Algo
 
MsgBox ("Sélectionner le jeu d'essai d'entrée:")
wk_in = Dir(Application.GetOpenFilename("Fichier Excel (*.xls), *.xls"))
 
MsgBox ("Sélectionner le jeu d'essai de sortie:")
wk_out = Dir(Application.GetOpenFilename("Fichier Excel (*.xls), *.xls"))
 
MsgBox ("Sélectionner le jeu d'essai au nouveau format:")
wk_new = Dir(Application.GetOpenFilename("Fichier Excel (*.xls), *.xls"))
 
 
 
 
 
 
'--------------------------------------------------------------------
'                           ONGLETS DE SORTIE                       |
'--------------------------------------------------------------------
 
 
 
'__________onglet OUT-Matr_1
 
Workbooks(wk_out).Worksheets("MODACCEPT").Range(Range("B1:G1"), Range("B1:G1").End(xlDown)).Copy Workbooks(wk_new).Worksheets("OUT-Matr_1 MODACCEPT").Range("C2")
 
'Workbooks(wk_out).Activate
'Worksheets("MODACCEPT").Range("B1:G1", Selection.End(xlDown)).Copy
 
 
'Workbooks(wk_new).Activate
'Worksheets("OUT-Matr_1 MODACCEPT").Select
'Range("C2").Select
'ActiveSheet.Paste
 
 
 
For I = 1 To Range("C1").End(xlDown).Row - 1
    Cells(I + 1, 1) = "id lig matr " & I
    Cells(I + 1, 1).Interior.ColorIndex = 6
    Cells(I + 1, 2) = I
    Cells(I + 1, 4).NumberFormat = "0.00000000000000000"
    Cells(I + 1, 6).NumberFormat = "0.00000000000000000"
    If Cells(I + 1, 6).Value = "" Then
        Cells(I + 1, 6) = "0.0"
        Cells(I + 1, 6).NumberFormat = "0.0"
    End If
    Cells(I + 1, 7).HorizontalAlignment = xlRight
Next
 
'Range("C2").Select
Range("C2", Selection.End(xlDown)).Select
    Selection.Replace What:="Z1", Replacement:="1", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace What:="Z2", Replacement:="2", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace What:="Z3", Replacement:="3", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace What:="Z4", Replacement:="4", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace What:="sin(S)", Replacement:="61", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace What:="cos(S)", Replacement:="62", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace What:="sin(2S)", Replacement:="63", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace What:="cos(2S)", Replacement:="64", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace What:="t", Replacement:="71", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace What:="R1", Replacement:="101", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace What:="R2", Replacement:="102", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Selection.Replace What:="-", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
 
 
 
'__________onglet OUT-Matr_2
Workbooks(wk_out).Activate
Worksheets("TAB_CONV").Select
Range("E2:E6").Select
Set A = Range(Selection, Selection.End(xlToRight))
A.Cells(3, 1).EntireRow.Delete
A.Copy
 
Workbooks(wk_new).Activate
Worksheets("OUT-Matr_2").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
 
For I = 1 To Range("B1").End(xlDown).Row - 1
    Cells(I + 1, 1) = "id lig matr " & I
    Cells(I + 1, 1).Interior.ColorIndex = 6
Next
 
 
 
End Sub

Et l'erreur qui m'est retournée est: "Erreur 1004 | Erreur définie par l'application ou par l'objet"

Merci du coup de main, car je ne suis pas encore un pro dans ce langage^^

**Mikaz** · 29/07/2009, 15h46

Il faut ouvrir ton workbook si jme trompe pas

**Krovax** · 29/07/2009, 14h47

plus cour oui sans trop de problème

en une ligne

Code :

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

Workbooks(wk_out).Worksheets("feuil1").Range(Range("B1:G1"), Range("B1:G1").End(xlDown)).Copy Workbooks(wk_new).Worksheets("feuil2").Range("C2")

D'ailleur tu avais gardé un selection quyi aller je pense te poser plusieurs souci

Edit : arf j'en ai mis du temps pour vérifier la syntaxe (y avait quelque souci de parenthèse) enfin exactement la m^me réponse que gorfael (bonjour) et avec le même doute

**Mikaz** · 29/07/2009, 14h49

Bon a savoir

Je ne connaissai pas du tt

VB Excel Copier/Coller

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager