Macro aide sur copie paste

**charlesssq** · 15/01/2010, 15h13

Bonjour,

J'essaie de faire le transfert de donnés d'un fichier vers un autre. Voici comment son placé mes donnés dans le premier fichier. où titres/ 1 / % sont chacun dans une colonne différente mais sur la même ligne et ce pour un fonds nommée AST36 en colonne A

AST36 titres 1 %
......... titres 2 %
......... titres 3 % etc
......... titres 10 %

Et mon but est de tout mettre (le nom du fonds et les dix titres boursiers) sur la même ligne un à la suite de l'autre dans un autre classeur.

Voici comment je voudrais procéder, mais je ne suis pas certain si cela est bon et si cela est efficace en terme de temps.

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
'DÉCLARE LES VARIABLES DE TYPES TABLEAUX POUR STOCKER LES DONNÉES
Dim ticker(1 To 1000) As Variant, tickerfonds As Variant, tickerrecherche As Variant
Dim fichierDATA As String, fichierGDF As String, valeur(1 To 100) As String
Dim LD As Variant, frais As Variant, lignedepart As Variant, Ligneticker As Variant
 
'DÉCLARE LES CONSTANTES UTILISÉES DANS LA PROCÉDURE. EN CAS DE MODIFICATIONS DES CODES, CE SONT
'CES CONSTANTES QUE VOUS DEVEZ MODIFIER.
Private Const SHEET_TRAVAIL_GUIDE = "detailFonds" 'Dans le guide des fonds
Private Const WORKBOOK_GUIDE = "guide des fonds.xls" 'Dans la Procédure de saisie
Private Const WORKBOOK_DATA = "DATA.xls" 'Dans le fichier DATA.xls
Private Const SHEET_TRAVAIL_DATA = "10 TITRES" 'Dans le fichier DATA.xls
Private Const WORKBOOK_PROCEDURE_GUIDE = "Procédure guide des fonds.xls"
'CHEMIN UTILISER DANS LA PROCÉDURE. C'EST LUI QUE VOUS DEVEZ MODIFIER EN CAS DE CHANGEMENTS.
Private Const CHEMIN_DATA = "G:\Suivi des fonds\Outils\DATA\DATA.xls"
Private Const CHEMIN_GDF = "G:\Suivi des fonds\Outils\DATA\guide des fonds.xls"
Sub Importation_Dix_titres()
Application.ScreenUpdating = False
'**********************************************************************************************
'OUVERTURE DU DATA PRINCIPAL
'**********************************************************************************************
'Pour ouvrir le fichier DATA - Caisses.xls. S'il est déjà ouvert, alors la macro se poursuivra, sinon, elle l'ouvrira.
fichierDATA = "non"
    For Each Fichier In Application.Workbooks 'On parcours chacun des classeurs Excel ouverts.
        If Fichier.Name = WORKBOOK_DATA Then 'S'il y en a 1 qui s'appelle DATA.xls, alors on tourne la switch à oui.
            fichierDATA = "oui" 'Switch
            GoTo Commencer 'Sort de la boucle
        End If
    Next Fichier 'Passe au prochain fichier
    If fichierDATA <> "oui" Then 'Une fois la boucle complétée, si la Switch n'a pas été tournée à oui, alors ouvre le fichier DATA.xls
        Workbooks.Open CHEMIN_DATA 'CHEMIN_DATA est déclaré en constante, c'est le chemin à utiliser pour ouvrir le fichier DATA.xls
    End If
Windows(WORKBOOK_DATA).Activate 'On active le DATA.xls
Application.Run "'DATA.xls'!AfficherDATA"
' voir Module Fonctionnement pour "AfficherDATA"
Commencer:
 
'**********************************************************************************************
'OUVERTURE DU GUIDE DES FONDS
'**********************************************************************************************
'Pour ouvrir le fichier Guide des fonds.xls. S'il est déjà ouvert, alors la macro se poursuivra, sinon, elle l'ouvrira.
fichierGDF = "non"
    For Each Fichier In Application.Workbooks 'On parcours chacun des classeurs Excel ouverts.
        If Fichier.Name = WORKBOOK_GUIDE Then 'S'il y en a 1 qui s'appelle guide des fonds.xls, alors on tourne la switch à oui.
            fichierGDF = "oui" 'Switch
            GoTo Commencer1 'Sort de la boucle
        End If
    Next Fichier 'Passe au prochain fichier
    If fichierGDF <> "oui" Then 'Une fois la boucle complétée, si la Switch n'a pas été tournée à oui, alors ouvre le fichier guide des fonds.xls
        Workbooks.Open CHEMIN_GDF 'CHEMIN_GDF est déclaré en constante, c'est le chemin à utiliser pour ouvrir le fichier guide des fonds.xls
    End If
Windows(WORKBOOK_GUIDE).Activate 'On active le DATA.xls
Application.Run "'Procédure guide des fonds.xls'!AfficherGDF"
' voir Module Fonctionnement pour "AfficherGDF"
Commencer1:
'*******************************************************************************************
' On commence l'importation vers le guide des fonds.
'*******************************************************************************************
' On active DATA et sélectionne le bon onglet
Application.Workbooks(WORKBOOK_DATA).Activate
Sheets(SHEET_TRAVAIL_DATA).Select
' Mets en mémoire les ticker, en allant les chercher au bon endroit
For i = 1 To 1000
    ticker(i) = Cells(i, 1).Value
    tickerfonds = ticker(i)
Next i
'TROUVE LA LIGNE DU Ticker DANS DATA.xls, onglet 10 TITRES
Set LD = Range("A1:A10000").Find(tickerfonds, LookIn:=xlFormulas, LookAt:=xlWhole)
    If Not LD Is Nothing Then
    lignedepart = LD.Row
Else
    MsgBox "Vérifier car ce Ticker ne semble pas exister"
End If
'On commence le transfert vers le guide des fonds
Application.Workbooks(WORKBOOK_GUIDE).Activate
Sheets(SHEET_TRAVAIL_GUIDE).Select
For i = 1 To 1000
    tickerrecherche = ticker(i)
    Set Ligneticker = Range("A1:A10000").Find(tickerrecherche, LookIn:=xlValues, LookAt:=xlWhole)
    If Not Ligneticker Is Nothing Then
    Fonds = Ligneticker.Row
 
    For lignedepart = 1 To 1000
        Cells(Fonds, 50).Value = Cells(lignedepart, 3).Value
        Cells(Fonds, 51).Value = Cells(lignedepart, 4).Value
        Cells(Fonds, 52).Value = Cells(lignedepart, 5).Value
        Cells(Fonds, 53).Value = Cells(lignedepart, 6).Value
        Cells(Fonds, 54).Value = Cells(lignedepart, 7).Value
 
        Cells(Fonds, 55).Value = Cells(lignedepart + 1, 3).Value
        Cells(Fonds, 56).Value = Cells(lignedepart + 1, 4).Value
        Cells(Fonds, 57).Value = Cells(lignedepart + 1, 5).Value
        Cells(Fonds, 58).Value = Cells(lignedepart + 1, 6).Value
        Cells(Fonds, 59).Value = Cells(lignedepart + 1, 7).Value
 
        Cells(Fonds, 60).Value = Cells(lignedepart + 2, 3).Value
        Cells(Fonds, 61).Value = Cells(lignedepart + 2, 4).Value
        Cells(Fonds, 62).Value = Cells(lignedepart + 2, 5).Value
        Cells(Fonds, 63).Value = Cells(lignedepart + 2, 6).Value
        Cells(Fonds, 64).Value = Cells(lignedepart + 2, 7).Value
 
        Cells(Fonds, 65).Value = Cells(lignedepart + 3, 3).Value
        Cells(Fonds, 66).Value = Cells(lignedepart + 3, 4).Value
        Cells(Fonds, 67).Value = Cells(lignedepart + 3, 5).Value
        Cells(Fonds, 68).Value = Cells(lignedepart + 3, 6).Value
        Cells(Fonds, 69).Value = Cells(lignedepart + 3, 7).Value
 
        Cells(Fonds, 70).Value = Cells(lignedepart + 4, 3).Value
        Cells(Fonds, 71).Value = Cells(lignedepart + 4, 4).Value
        Cells(Fonds, 72).Value = Cells(lignedepart + 4, 5).Value
        Cells(Fonds, 73).Value = Cells(lignedepart + 4, 6).Value
        Cells(Fonds, 74).Value = Cells(lignedepart + 4, 7).Value
 
        Cells(Fonds, 75).Value = Cells(lignedepart + 5, 3).Value
        Cells(Fonds, 76).Value = Cells(lignedepart + 5, 4).Value
        Cells(Fonds, 77).Value = Cells(lignedepart + 5, 5).Value
        Cells(Fonds, 78).Value = Cells(lignedepart + 5, 6).Value
        Cells(Fonds, 79).Value = Cells(lignedepart + 5, 7).Value
 
        Cells(Fonds, 80).Value = Cells(lignedepart + 6, 3).Value
        Cells(Fonds, 81).Value = Cells(lignedepart + 6, 4).Value
        Cells(Fonds, 82).Value = Cells(lignedepart + 6, 5).Value
        Cells(Fonds, 83).Value = Cells(lignedepart + 6, 6).Value
        Cells(Fonds, 84).Value = Cells(lignedepart + 6, 7).Value
 
        Cells(Fonds, 85).Value = Cells(lignedepart + 7, 3).Value
        Cells(Fonds, 86).Value = Cells(lignedepart + 7, 4).Value
        Cells(Fonds, 87).Value = Cells(lignedepart + 7, 5).Value
        Cells(Fonds, 88).Value = Cells(lignedepart + 7, 6).Value
        Cells(Fonds, 89).Value = Cells(lignedepart + 7, 7).Value
 
        Cells(Fonds, 90).Value = Cells(lignedepart + 8, 3).Value
        Cells(Fonds, 91).Value = Cells(lignedepart + 8, 4).Value
        Cells(Fonds, 92).Value = Cells(lignedepart + 8, 5).Value
        Cells(Fonds, 93).Value = Cells(lignedepart + 8, 6).Value
        Cells(Fonds, 94).Value = Cells(lignedepart + 8, 7).Value
 
        Cells(Fonds, 95).Value = Cells(lignedepart + 9, 3).Value
        Cells(Fonds, 96).Value = Cells(lignedepart + 9, 4).Value
        Cells(Fonds, 97).Value = Cells(lignedepart + 9, 5).Value
        Cells(Fonds, 98).Value = Cells(lignedepart + 9, 6).Value
        Cells(Fonds, 99).Value = Cells(lignedepart + 9, 7).Value
 
Next i
 
End Sub

Merci beaucoup de votre aide, je débute dans les macros et je ne suis pas encore certain des bonnes manières de faire

sincèrement,
Charles

Macro aide sur copie paste

Macros et VBA Excel

Mode arborescent

Discussions similaires

Partager

Partager