Voici mon code mais pour l'instant il n'y a que 5 fichiers .txt d'inséré mais par la suite il y en aura 18 donc si une simplification existe.

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
 
Sub users_16_05_06()
 
Dim service As String
Dim Responsable As String
Dim nbligne As Integer
 
'Workbooks.Add
NomFich = ActiveWorkbook.Name
Workbooks.OpenText Filename:="\\Bre3301\config$\icones\maryse.nourisson\Bureau\Guillaume.mulot\bureau etudes", _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
Semicolon:=True
Workbooks.OpenText Filename:="\\Bre3301\config$\icones\maryse.nourisson\Bureau\Guillaume.mulot\atelier", _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
Semicolon:=True
Workbooks.OpenText Filename:="\\Bre3301\config$\icones\maryse.nourisson\Bureau\Guillaume.mulot\achats", _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
Semicolon:=True
Workbooks.OpenText Filename:="\\Bre3301\config$\icones\maryse.nourisson\Bureau\Guillaume.mulot\achats projet", _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
Semicolon:=True
Workbooks.OpenText Filename:="\\Bre3301\config$\icones\maryse.nourisson\Bureau\Guillaume.mulot\chefs de projets", _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
Semicolon:=True
 
Windows("bureau etudes.txt").Activate
Sheets("bureau etudes").Select
Sheets("bureau etudes").Copy Before:=Workbooks(NomFich).Sheets(1)
Workbooks("bureau etudes").Close
Windows("atelier.txt").Activate
Sheets("atelier").Select
Sheets("atelier").Copy Before:=Workbooks(NomFich).Sheets(1)
Workbooks("users_16_05_06.xls").Sheets("atelier").Activate
Workbooks("atelier").Close
Windows("achats.txt").Activate
Sheets("achats").Select
Sheets("achats").Copy Before:=Workbooks(NomFich).Sheets(1)
Workbooks("users_16_05_06.xls").Sheets("achats").Activate
Workbooks("achats").Close
Windows("achats projet.txt").Activate
Sheets("achats projet").Select
Sheets("achats projet").Copy Before:=Workbooks(NomFich).Sheets(1)
Workbooks("users_16_05_06.xls").Sheets("achats projet").Activate
Workbooks("achats projet").Close
Windows("chefs de projets.txt").Activate
Sheets("chefs de projets").Select
Sheets("chefs de projets").Copy Before:=Workbooks(NomFich).Sheets(1)
Workbooks("users_16_05_06.xls").Sheets("chefs de projets").Activate
Workbooks("chefs de projets").Close
 
Worksheets("atelier").Activate
 
Range("D1") = "Responsable"
 
nbligne = Range("C65000").End(xlUp).Row
 
For Index = 2 To nbligne
service = Range("C" & Index)
 
Select Case service
Case "Achats Projet", "Achats"
Responsable = "BNT"
Case "Atelier", "Production"
Responsable = "PHR"
Case "Bureau Etudes", "Ingéniérie Process", "Prototypes"
Responsable = "JT"
Case "Chefs de Projets", "Metrologie", "Qualite Cout Délais"
Responsable = "EV"
Case "Commercial"
Responsable = "SA"
Case "Logistique"
Responsable = "CT"
Case "Informatique", "Finances"
Responsable = "FBE"
Case "Entretien"
Responsable = "VT"
Case "Direction Qualite"
Responsable = "JBQ"
Case Else
Responsable = "ADB"
End Select
 
Range("D" & Index) = Responsable
 
Next

Merci de votre aide