Bonjour à tous,

J’ai besoin de votre aide pour résoudre un problème sur lequel je planche depuis déjà 3 semaines.
J’ai crée une macro me permet de copier d’une Feuille X des data dans une Feuille Y.
Tout ce passe bien quand :
1. Une personne travaille sur Feuille X pour envoyer les data dans Feuille Y
2. Deux feuille travailles sur Feuille X (dont une en lecture seule) pour envoyer les data dans Feuille Y. L'envoie ne se fait pas en même temps.
Par contre GROS problème quand:
Deux ou plusieurs personnes travailles sur Feuille X et envoient en même temps des data dans Feuille Y alors la, la macro bug pour une des personnes.
1. Je voudrais votre aide pour savoir comment permettre a plusieurs personnes d’envoyer les donnés en même temps dans la Feuille Y sans que la macro bug.
2. Pensez-vous que le fait de dire à la macro d’ouvrir la Feuille Y pour y copier les éléments rende la macro plus lente ?
Merci beaucoup beaucoup pour votre aide.
Pics.


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
Sub ExportData()
 
Application.ScreenUpdating = False
 
Dim i As Integer
Dim j As String
 
ChDir "S:\xxxxxxxxx"
NomFichier = "Feuille Y.xls"
Workbooks.Open Filename:=NomFichier
Sheets("y").Select
 
Workbooks("Feuille X'.xls").Activate
Sheets("x").Select
 
Range("A1").Select
 
For i = 1 To 1
 
If ActiveCell.Value = "" Then
ActiveCell.Offset(1, 0).Select
 
Else
 
If ActiveCell.Value = "MACRO" Then
ActiveCell.Offset(2, 0).Select
 
Else
j = ActiveCell.Address
ActiveCell.Offset(0, 3).Select
Range("D1 : Q1").Select
Selection.Copy
 
Workbooks("Feuille Y.xls").Activate
Sheets("y").Select
 
Range("B2").Select
 
While ActiveCell <> ""
ActiveCell.Offset(1, 0).Select
Wend
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 
Workbooks("Feuille X.xls").Activate
Sheets("x").Select
Range(j).Select
ActiveCell.Offset(2, 0).Select
 
End If
 
End If
 
Next i
 
Application.CutCopyMode = False
 
Workbooks("Feuille Y.xls").Activate
Sheets("y").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
 
Workbooks("Feuille X.xls").Activate
Sheets("x").Select
 
Range("A1").Select
 
End Sub