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
| Sub ImporterListeTouret()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim ValCel
Dim LtCel
Dim Macellule
ValCel = 30 'Nombre de lignes non vide
LtCel = "k"
Macellule = LtCel & ValCel 'donc dans cet ex K30
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
If objFolder Is Nothing Then
MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else
'Columns (1) .NumberFormat = "m/d/yyyy"
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
[B1] = Chemin
fichier = Dir(Chemin & "*.xls")
Do While Len(fichier) > 0
If fichier <> ThisWorkbook.Name Then
ThisWorkbook.Names.Add "Plage", _
RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$A$1"
With Sheets("Feuil2")
.[A1:Macellule] = "=Plage"
.[A1:Macellule].Copy
Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = fichier
End With
End If
fichier = Dir()
Loop
End If
End Sub |
