Discussion :

[vadius]

Bonjour tout le monde

Cela fait plusieurs que j'essaie de creer une macro afin de concatener pres de 300 fichiers xls..J'ai trouve quelques morceaux de codes que j'ai essaye d'arranger mais je suis bloque. Les debuts en VBA sont decidements pas evidents.

Les 2 premiers fichiers en PJ sont deux exemples des 300 fichiers que j'essaie de compiler. Ils ont tous le meme format et ce sont les extracts dont je fais allusion plus loin.

L'objectif est ici d'obtenir un tableau dans lequel il y aurait dans la premiere colonne l'ensemble des dates (dans les extracts = Cell(A,1)), puis le prix (dans les extracts "Close" Cell(E6)) pour chacune des 20 societes (Nestle, Novartis...Lonza). Ainsi pour chaque journee, nous aurions les prix de cloture des 20 societes sur une seule ligne. Les prix de cloture sont facilement telechargeables mais j'ai en fait besoin d'autres info telles aue F.Float etc, il me suffira ensuite d'adapter le code que je serai parvenu a faire grace a vous.

Ci-dessous un debut de code. Le code lit l'ensemble des fichiers presents dans un dossier "Clean Extract" et tente de recuperer les prix (colonne C des extracts).

Mon premier probleme est que les donnees sont copiees, mais en colonne. J ai essaye de trouver une variante de TargetRange.Cells(1, 1).CopyFromRecordset rsData pour ajouter une fonction transpose mais je n'ai pas reussi.

Un second probleme serait egalement d'arriver a mettre sur une premiere ligne les noms des entreprises (de B1 a U1) puis les prix correspondants sur la lignes du dessous (C2 a U2) avec la date en C1. Et ainsi de suite pour tous les extracts presents dans le meme dossier. (j'en ai pres de 300).

J'espere avoir ete suffisament clair, merci d'avance a ceux qui sauront m'aider.

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
Option Explicit
 
' Copy a range from all files in a folder
 
 
' This example will copy a range from all files that are in the folder C:\Users\Ron\Test
' It will add a new worksheet to your workbook with all the data in it.
 
Sub GetData_Example6()
    Dim MyPath As String
    Dim FilesInPath As String
    Dim sh As Worksheet
    Dim MyFiles() As String
    Dim Fnum As Long
    Dim rnum As Long
    Dim destrange As Range
 
    MyPath = "H:\SMI Index Compo Watch\201007\CleanExtract"    ' <<<<  Change
 
    'Add a slash at the end if the user forget it
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If
 
    'If there are no Excel files in the folder exit the sub
    FilesInPath = Dir(MyPath & "*.xl*")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If
 
    On Error GoTo CleanUp
    Application.ScreenUpdating = False
 
    'Add worksheet to the Activeworkbook and use the Date/Time as name
    Set sh = ActiveWorkbook.Worksheets.Add
    sh.Name = Format(Now, "dd-mm-yy h-mm-ss")
 
    'Fill the array(myFiles)with the list of Excel files in the folder
    Fnum = 0
    Do While FilesInPath <> ""
        Fnum = Fnum + 1
        ReDim Preserve MyFiles(1 To Fnum)
        MyFiles(Fnum) = FilesInPath
        FilesInPath = Dir()
    Loop
 
    'Loop through all files in the array(myFiles)
    If Fnum > 0 Then
        For Fnum = LBound(MyFiles) To UBound(MyFiles)
 
            'Find the last row with data
            rnum = LastRow(sh)
 
            'create the destination cell address
            Set destrange = sh.Cells(rnum + 1, "A")
 
            'Get the cell values and copy it in the destrange
            'Change the Sheet name and range as you like
            GetData MyPath & MyFiles(Fnum), "", "D7:D26", destrange, True, True
        Next
    End If
 
 
    'setdatextract
 
CleanUp:
    Application.ScreenUpdating = True
 
 
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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Option Explicit
 
 
Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect As String
    Dim szSQL As String
    Dim lCount As Long
 
    ' Create the connection string.
    If Header = False Then
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
        End If
    Else
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=Yes"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
    End If
 
    If SourceSheet = "" Then
        ' workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
    Else
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If
 
    On Error GoTo SomethingWrong
 
    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")
 
    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1
 
    ' Check to make sure we received data and copy the data
    If Not rsData.EOF Then
 
        If Header = False Then
            TargetRange.Cells(1, 1).CopyFromRecordset rsData
 
        Else
            'Add the header cell in each column if the last argument is True
            If UseHeaderRow Then
                For lCount = 0 To rsData.Fields.Count - 1
                    TargetRange.Cells(1, 1 + lCount).Value = _
                    rsData.Fields(lCount).Name
                Next lCount
                TargetRange.Cells(2, 1).CopyFromRecordset rsData
            Else
                TargetRange.Cells(1, 1).CopyFromRecordset rsData
            End If
        End If
 
    Else
        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If
 
    ' Clean up our Recordset object.
    rsData.Close
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing
    Exit Sub
 
SomethingWrong:
    MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0
 
End Sub

[jfontaine]

Bonjour,

Si je comprend bien ce que tu souhaites faire, c'est lire plusieurs fichiers et intégrer leurs données dans un tableau de présentation date en ligne et Société en Colonne avec en données les prix.

Si c'est bien le cas, une solution qui me semble adaptée est de créer une base de donnée et de pointer sur cette BDD pour faire toute sorte de restitution en utilisant les TCD ou plus complexes avec des formules ou en macro.

[vadius]

Bonsoir

C'est exactement ce que je veux faire. En revanche je ne sais pas du tout comment creer une base de donnees. que signifie TCD ?
Merci

[jfontaine]

TCD => Tableau croisé dynamique

Tu peux utiliser un onglet d'excel pour faire ta BDD si le nombre d'enregistrement (ou lignes) n'est pas trop élevé

[vadius]

Je cherche une solution en code que je puisse updater ma spreadsheet rapidement. Pour le TCD, j ai 300 fichiers a lire ou aller recuperer les donnees etc..

[jfontaine]

Les fichiers en entrée sont sous quel format? Txt, csv, xls ...

[vadius]

ce sont les fichiers xls en PJ

a la base ils osnt en csv mais je les ai convertis

Merci

[NoobProg]

Si ce sont des fichiers XLS, tu as juste à crée une nouvelle page dans ton fichier excel où tu vas tout récapituler dans laquelle tu vas faire ta base de données. D'où tu pourras appeller toute les informations que tu veux.

Mais sinon, où se situe exactement ton problème de code ?

[vadius]

je vois pas tres bien comment ajouter a la main les 300 fichiers excel pour creer ma base...

Pour le code : le probleme c'est que je veux copier et transposer certaines colonnes. Le code que j ai trouve copy et colle les colonnes de donnees. Or j'aurais besoin de transposer ces colonnes de donnees. Et je ne vois pas comment modifier le code...

[NoobProg]

je vois pas tres bien comment ajouter a la main les 300 fichiers excel pour creer ma base...

Justement le but serai de créer une macro pour créer ta base de données non ?

[jfontaine]

Si tu reçois tes fichiers en CSV, il serait plus simple de les importer dans ce format.
http://excel.developpez.com/sources/...oupeTxtFeuille

[vadius]

Ok je n'avais pas compris pour la macro. Oui l'idee est de creer une micro pour importer mes 300 fichiers.

fontaine: Peut etre, mais comme le csv est illisible j ai tout pass een xls..

merci