Copier des données entre 2 fichiers Excel déjà ouverts

**Mandou01** · 27/03/2017, 17h15

Bonjour à tous, et d'avance merci à ceux qui pourront m'aider.

Je cherche un petit bout de macro, je pense que je ne suis pas trop loin de la vérité, qui me permettra de copier / coller des informations d'un fichier A vers un fichier B, alors que les 2 fichiers sont déjà ouverts.

Voilà ce que j'ai déjà fait, mais ce bout de macro m'oblige à avoir le fichier A (RépaLite) fermé, d'aller le chercher, de l'ouvrir puis de le fermer ce qui est assez contraignant.

N'hésitez pas à me dire si je ne suis pas claire et si vous avez besoin de compléments.

merci encore

Mandou

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
Dim chemin As String
 
msg = MsgBox("Mettre à jour les nouvelles LS ?", vbYesNo)
If msg = vbYes Then
    chemin = Application.GetOpenFilename
    If chemin <> "Faux" Then
    Application.ScreenUpdating = False
    Call Maj_LS(chemin)
    End If
 
End If
msg = MsgBox("Terminé !", vbInformation)
End Sub
 
 
'Dans le fichier RépaLite, sélectionner les nouvelles LS et les copier
Public Sub Maj_LS(chemin As String)
 
Application.ScreenUpdating = False
 
Dim Repa As String
Dim fichierEcritures As String
 
Dim derligne As Integer
 
 
fichierEcritures = ActiveWorkbook.Name 'fichier Ecritures export
 
Application.DisplayAlerts = False
 
Workbooks.Open Filename:=chemin
Repa = ActiveWorkbook.Name 'fichier RepaLite
 
Sheets("Data").Select
derligne_repa = Sheets("Data").Range("B7").CurrentRegion.Rows.Count
derligne_repa = derligne_repa + 1
 
 
ligLS = 7 'on positionne le pointeur des LS dans RépaLite au début
For j = ligLS To derligne_repa
 
'on cherche les nouvelles LS
If Workbooks(Repa).Sheets("Data").Cells(j, "J").Value = "0-ok à faire" Then
 
    'on a trouvé une LS
    'on cherche si elle existe déjà
    Workbooks(fichierEcritures).Sheets("ECRITURES_EXP_2016_2017").Activate
    derligne = Range("B3").End(xlDown).Row
    derligne = derligne + 1
    i = derligne
    For ligecrit = 3 To derligne
        If Workbooks(Repa).Sheets("Data").Cells(ligLS, 2).Value = Sheets("ECRITURES_EXP_2016_2017").Cells(ligecrit, 2) Then
            GoTo ligLSsuivante 'la LS existe déjà, on passe à la LS suivante
        End If
    Next 'on teste la ligne suivante pour voir si la LS existe
    'la LS n'existe pas encore, on la recopie
 
        'on copie le n° de LS
        Workbooks(Repa).Sheets("Data").Activate
        Range("B" & j).Copy
        Workbooks(fichierEcritures).Sheets("ECRITURES_EXP_2016_2017").Activate
        Range("B" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
 
        'on copie le ship to party
        Workbooks(Repa).Sheets("Data").Activate
        Range("W" & j).Copy
        Workbooks(fichierEcritures).Sheets("ECRITURES_EXP_2016_2017").Activate
        Range("F" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
        'on copie le nom
        Workbooks(Repa).Sheets("Data").Activate
        Range("X" & j).Copy
        Workbooks(fichierEcritures).Sheets("ECRITURES_EXP_2016_2017").Activate
        Range("G" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
        'on copie la ville
        Workbooks(Repa).Sheets("Data").Activate
        Range("AB" & j).Copy
        Workbooks(fichierEcritures).Sheets("ECRITURES_EXP_2016_2017").Activate
        Range("H" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
        'on copie l'incoterm
        Workbooks(Repa).Sheets("Data").Activate
        Range("AE" & j).Copy
        Workbooks(fichierEcritures).Sheets("ECRITURES_EXP_2016_2017").Activate
        Range("O" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
        'on copie le pays
        Workbooks(Repa).Sheets("Data").Activate
        Range("AC" & j).Copy
        Workbooks(fichierEcritures).Sheets("ECRITURES_EXP_2016_2017").Activate
        Range("I" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
        'on copie le statut SG/HG
        Workbooks(Repa).Sheets("Data").Activate
        Range("AK" & j).Copy
        Workbooks(fichierEcritures).Sheets("ECRITURES_EXP_2016_2017").Activate
        Range("D" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
        'on copie le prix
        Workbooks(Repa).Sheets("Data").Activate
        Range("AT" & j).Copy
        Workbooks(fichierEcritures).Sheets("ECRITURES_EXP_2016_2017").Activate
        Range("AA" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
        'on a traité la ligne, on passe à la suivante
        GoTo ligLSsuivante
    Else
ligLSsuivante:
    ligLS = ligLSsuivante + 1
    End If
    Next
 
Call mise_en_forme
 
Call doublons
 
Windows(Repa).Activate
ActiveWindow.Close SaveChanges:=False
Application.DisplayAlerts = True
 
End Sub

**Marc-L** · 27/03/2017, 17h20

Bonjour !

conformément aux règles de ce forum ‼

Et ce n'est pas contraignant car c'est le plus simple !

Sinon parmi les tutoriels pourtant à disposition sur ce forum : Lire et écrire dans les classeurs Excel fermés …

___________________________________________________________________________________________________________

Je suis Paris, London, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

**Mandou01** · 30/03/2017, 14h19

Bonjour

Désolée pour le non respect des consignes

En fait ce qui m'embête dans ma macro c'est qu'Excel ne veut pas aller plus loin puisque le fichier est déjà ouvert. Il n'arrive pas à se mettre en lecture seule. J'ai du oublier un morceau de code.

Merci

**riaolle** · 30/03/2017, 14h30

Bonjour,
Peux-tu nous préciser quel est ton message d'erreur et à quelle ligne il apparaît, stp?

**joe.levrai** · 30/03/2017, 14h38

Bonjour,

d'habitude le forum est sollicité pour complexifier une procédure
ici, c'est l'inverse, tu veux simplement ne plus avoir de sélection/ouverture/fermeture du fichier puisqu'il est déjà ouvert

il te suffit de supprimer toutes les lignes réalisant ces actions (les .Open .Close, les premières lignes où tu GetOpenfileName pour choisir un fichier etc..)
et à la place d'utiliser une variable "Classeur" dans laquelle tu met ton classeur B pour y faire référence

je n'ai pas lu plus profondément ton code, mais je suis certain qu'il y a beaucoup de circonlocutions qui donnent un code super long, qui pourrait être considérablement réduit

**riaolle** · 30/03/2017, 14h44

Envoyé par joe.levrai

Bonjour,
je n'ai pas lu plus profondément ton code, mais je suis certain qu'il y a beaucoup de circonlocutions qui donnent un code super long, qui pourrait être considérablement réduit

En effet, petit conseil pour alléger ton code. Utilise le moins possible (voir pas du tout

) les Select et Activate qui ne font qu'entrainer des problèmes difficiles à résoudre.
Au lieu de :

Code :

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

1
2
3
4
5
6
'on copie le n° de LS
Workbooks(Repa).Sheets("Data").Activate
Range("B" & j).Copy
Workbooks(fichierEcritures).Sheets("ECRITURES_EXP_2016_2017").Activate
Range("B" & i).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Ecris:

Code :

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

1
2
3
'on copie le n° de LS
Workbooks(Repa).Sheets("Data"). Range("B" & j).Copy
Workbooks(fichierEcritures).Sheets("ECRITURES_EXP_2016_2017").Range("B" & i).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Copier des données entre 2 fichiers Excel déjà ouverts

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager