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