Bonjour,

Cette sub fonctionnait parfaitement sous office 2000, et suite à migration vers office 2003, impossible d'éxecuter la sub, pas de probléme pour l'accés au classeur lié, mais probleme lors de la récupération des données, en fait execution de la sub "Transfert". Je ne vois pas le problème . Merci de m'apporter votre aide...

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
Dim Mle, XCol, XLig, u_b As Integer
Dim Xfeuille As String
Dim XClasseur As Variant
 
Sub FlemeEngagement()
On Error GoTo GestErreur
With Selection
For I = 1 To Selection.Rows.Count
Mle = Selection.Cells(I, 1).Value
Set XClasseur = Application.ActiveWorkbook
XCol = ActiveCell.Column
XLig = ActiveCell.Row + I - 1
Xfeuille = ActiveCell.Worksheet.Name
    Windows("BASE 4RE.XLS").Activate
    Sheets("4°RE").Select
Columns("I").Find(Mle, , xlWhole).Activate
u_b = ActiveCell.Row
Transfert
GestErreur:
Workbooks(XClasseur.Name).Activate
Next I
End With
End Sub
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
Sub Transfert()
Grade = Cells(u_b, 5)
Name1 = Cells(u_b, 6)
Name2 = Cells(u_b, 7)
Mle1 = Cells(u_b, 9)
MleRec = Cells(u_b, 8)
Cie = Cells(u_b, 2)
BSN = Cells(u_b, 21)
NeLe = Cells(u_b, 23)
VILLE = Cells(u_b, 24)
DEPARTEMENT = Cells(u_b, 25)
PAYS = Cells(u_b, 26)
fils = Cells(u_b, 27)
Mere = Cells(u_b, 28)
Cheuveux = Cells(u_b, 29)
Yeux = Cells(u_b, 30)
Taille = Cells(u_b, 31)
 
Workbooks(XClasseur.Name).Activate
With Worksheets(Xfeuille)
    .Cells(XLig, XCol - 4) = Grade
    .Cells(XLig, XCol - 2) = Name1
    .Cells(XLig, XCol - 1) = Name2
    .Cells(XLig, XCol) = Mle1
    .Cells(XLig, XCol + 1) = MleRec
    .Cells(XLig, XCol - 5) = Cie
    .Cells(XLig, XCol + 7) = BSN
    .Cells(XLig, XCol + 2) = NeLe
    .Cells(XLig, XCol + 3) = VILLE
    .Cells(XLig, XCol + 5) = fils
    .Cells(XLig, XCol + 6) = Mere
    .Cells(XLig, XCol + 8) = Cheuveux
    .Cells(XLig, XCol + 9) = Yeux
    .Cells(XLig, XCol + 14) = Taille
End With
 
If PAYS = "FRANCE" Then
Worksheets(Xfeuille).Cells(XLig, XCol + 4) = DEPARTEMENT
Else: Worksheets(Xfeuille).Cells(XLig, XCol + 4) = PAYS
End If
 
Select Case Grade
Case Is = "MAJ"
Grade1 = "Major"
Case Is = "ADC"
Grade1 = "Adjudant-chef"
Case Is = "ADJ"
Grade1 = "Adjudant"
Case Is = "SCH"
Grade1 = "Sergent-chef"
Case Is = "SGT"
Grade1 = "Sergent"
Case Is = "CCH"
Grade1 = "Caporal-chef"
Case Is = "CPL"
Grade1 = "Caporal"
Case Is = "1CL"
Grade1 = "Soldat de 1ère classe"
Case Is = "LEG"
Grade1 = "Soldat"
End Select
 
Worksheets(Xfeuille).Cells(XLig, XCol - 3) = Grade1
 
End Sub