Macro Import de donnees de plusieurs fichier excel ds une base de donnees

Cest bon j'ai trouve;)

voici mon code

Code:

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
Sub PierreMenager()
'
' PierreMenager Macro
' Macro recorded 8/15/2007 by PM
'
' Keyboard Shortcut: Ctrl+p
'
Filename1 = InputBox("Please, type the date. ( Ex: 0608 )", "Information Requested")
Filename = "2007BeanStorPlan" & Filename1 & ".xls"
 
    Range("C11").FormulaR1C1 = _
        "='[" & Filename & "](c) stock estimate fut.'!R5C2+'[" & Filename & "](c) stock estimate fut.'!R5C18"
    Range("C12").Select
    ActiveCell.FormulaR1C1 = _
        "='[" & Filename & "](c) stock estimate fut.'!R6C18+'[" & Filename & "](c) stock estimate fut.'!R7C18+'[" & Filename & "](c) stock estimate fut.'!R6C2+'[" & Filename & "](c) stock estimate fut.'!R7C2"
    Range("C13").Select
    'Application.Run Range("AUTOSAVE.XLA!mcs02.OnTime")
    'Application.Run Range("AUTOSAVE.XLA!mcs02.OnTime")
    'Application.Run Range("AUTOSAVE.XLA!mcs02.OnTime")
    'Application.Run Range("AUTOSAVE.XLA!mcs02.OnTime")
    'Application.Run Range("AUTOSAVE.XLA!mcs02.OnTime")
    'Application.Run Range("AUTOSAVE.XLA!mcs02.OnTime")
    ActiveCell.FormulaR1C1 = _
        "='[" & Filename & "](c) stock estimate fut.'!R4C2+'[" & Filename & "](c) stock estimate fut.'!R4C18"
    Range("C14").Select
 
    ActiveCell.FormulaR1C1 = _
        "='[" & Filename & "](c) stock estimate fut.'!R8C2+'[" & Filename & "](c) stock estimate fut.'!R8C18"
    Range("C19").Select
    ActiveCell.FormulaR1C1 = _
        "='[" & Filename & "]Bean storage overview'!R4C5"
    Range("C19").Select
    ActiveCell.FormulaR1C1 = _
        "='[" & Filename & "]Bean storage overview'!R5C5"
    Range("C20").Select
    ActiveCell.FormulaR1C1 = _
        "='[" & Filename & "]Bean storage overview'!R6C5+'[" & Filename & "]Bean storage overview'!R7C5"
    Range("C21").Select
    ActiveCell.FormulaR1C1 = _
        "='[" & Filename & "]Bean storage overview'!R4C5"
   Range("C22").Select
    ActiveCell.FormulaR1C1 = _
        "='[" & Filename & "]Bean storage overview'!R8C5"
Load UserForm1
UserForm1.Show
N = 1
Nomfich = Sheets("cache").Range("B1").Value
occ = UBound(Split(Nomfich, "\", -1, vbTextCompare))
Do
   N = N + 1
 Nomfich = Right(Nomfich, Len(Nomfich) - InStr(Nomfich, "\"))
 
 Loop Until N = occ + 1
    Range("C38").FormulaR1C1 = _
        "='[" & Nomfich & "]Stock available'!R16C4+'[" & Nomfich & "]Stock available'!R16C12"
 
    ActiveWindow.SmallScroll Down:=-3
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=-18
End Sub

Useform :

Code:

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
Private Sub OK_Click()
For I = 0 To List1.ListCount
    If List1.Selected(I) = True Then
        MsgBox "Selected Item: " & List1.List(I)
        Sheets("cache").Range("B1") = List1.List(I)
 
    End If
Next
UserForm1.Hide
End Sub
Private Sub UserForm_Initialize()
Dim Classeurs() As String
Dim I As Long
 
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeAllFiles
.Filename = "Daily-stock*.xls"
''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''
.LookIn = "C:\Documents and Settings\n008084\Desktop\richardbis"
.SearchSubFolders = True
.Execute
With .FoundFiles
ReDim Classeurs(1 To .Count, 1 To 1)
For I = 1 To .Count
List1.AddItem .Item(I)
Sheets("cache").Range("B" & I) = .Item(I)
Next I
 
End With
End With
 
End Sub