Gestion BDD avec FSO

Bonjour,

Je cale sur un projet.

Un client m'envoie toutes les semaines des fichiers excel de suivie de production. J'ai fais une macro pour faire la mise en forme de ceux-ci afin de suivre les rebus et retours d'excédents. Jusqu'à c'est OK.

Mon chef, me demande de faire une estimation des rebus et du taux de retour matière que l'on gère pour le client. Demande légitime, mais c'est un peu tard dans l'année au vue du nombre de fichier que j'ai déjà traité...

J'ai adapté une macro de PierreP56 pour récupérer les fichiers en onglets et c'est vraiment bien sauf que les données restent les unes à coté des autres.

Je souhaite recréer une Base De Données afin de traiter les demandes statistique en TCD.

Le bas blesse à ce moment, car je ne parviens pas à vider mes fichiers les uns en dessous des autres... et comme une difficulté ne vient souvent pas seule, même si mon fichier à toujours la même structure, j'ai pas toujours le même nombre de lignes. Bah oui, ce serait trop simple...

L'idée est donc de:

Trouver les fichiers non traités dans un dossier donné la macro de PierreP56 le fait nickel

Ouvrir le fichier la macro de PierreP56 le fait nickel

Copier de la cellule A2 à la cellules AA? du fichier source (hauteur de ligne définit par le nombre de ligne dans colonne A)

Copier les données les unes en dessous des autres dans l'onglet BDD

Fermer le fichier la macro de PierreP56 le fait nickel

Le déplacer dans un dossier fichiers traités. la macro de PierreP56 le fait nickel

J'ai donc tenté d'adapter la macro de pierre mais sans succès, car je ne parviens pas à copier coller les données les unes en dessous des autres. et encore moins de façon dynamique.

Macro actuelle

Sub ImportFilesexceltest()
Dim wbDest As Workbook, wbSource As Workbook
Dim wsDest As Worksheet, wsSource As Worksheet
Dim MyFile As String, myPath As String, myDest As String
Dim intNum As Integer
Dim FSO As Object
Dim J As Long

    Application.ScreenUpdating = False
    Set wbDest = ThisWorkbook
    Set wsDest = wbDest.Worksheets("BDD")
    myPath = "C:\Users\Equipe\Desktop\EXCEL en cours\testimport\"
    myDest = "C:\Users\Equipe\Desktop\EXCEL en cours\testimport\Traité\"
    MyFile = Dir(myPath & "*.xls")

    If MyFile = "" Then
        CreateObject("WScript.Shell").Run "mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""Pas de fichier à traiter"",2,""test""))"
        Exit Sub
    End If

    Do While MyFile <> ""
        Set wbSource = Workbooks.Open(myPath & MyFile)
        Set wsSource = wbSource.Worksheets(1)
        Set FSO = CreateObject("Scripting.FileSystemObject")

'Open wsDest For Random As wsSource 'Len = Len(client)

''Compte le nombre d'enregistrements
'intNum = LOF(wsSource) ' / Len(client)
''Ajoute la donnée
'Put wsSource, intNum + 1, wsDest

        wsSource.Copy after:=wbDest.Worksheets(1)

            Application.DisplayAlerts = False
            wbSource.Close
            Application.DisplayAlerts = True

'            fso.moveFile myPath & myFile, myDest & myFile

        MyFile = Dir
    Loop

    CreateObject("WScript.Shell").Run "mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""ImportBDD terminé"",1,""test""))"

    Set wsDest = Nothing: Set wsSource = Nothing
    Set wbDest = Nothing: Set wbSource = Nothing

End Sub

Bref, je cale.

Merci d'avance

Leakim

Bonjour,

Un essai qui fonctionne si le fichier de destination n'est pas dans le même dossier que les fichiers sources et que la dernière colonne des fichiers sources est "X" ...

Sub ImportFilesexceltest()
Dim wbDest As Workbook, wbSource As Workbook
Dim wsDest As Worksheet, wsSource As Worksheet
Dim MyFile As String, myPath As String, myDest As String
Dim intNum As Integer
Dim FSO As Object
Dim J As Long
Dim DligDest As Long
Dim DligSource As Long

   Application.ScreenUpdating = False
   Set wbDest = ThisWorkbook
   Set wsDest = wbDest.Worksheets("BDD")
   myPath = "C:\Users\Equipe\Desktop\EXCEL en cours\testimport\"
   myDest = "C:\Users\Equipe\Desktop\EXCEL en cours\testimport\Traité\"
   MyFile = Dir(myPath & "*.xls")

   If MyFile = "" Then
      CreateObject("WScript.Shell").Run "mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""Pas de fichier à traiter"",2,""test""))"
      Exit Sub
   End If

   Do While MyFile <> ""
      Set wbSource = Workbooks.Open(myPath & MyFile)
      Set wsSource = wbSource.Worksheets(1)
      Set FSO = CreateObject("Scripting.FileSystemObject")

      'Open wsDest For Random As wsSource 'Len = Len(client)

      ''Compte le nombre d'enregistrements
      'intNum = LOF(wsSource) ' / Len(client)
      ''Ajoute la donnée
      'Put wsSource, intNum + 1, wsDest

      DligSource = wsSource.Cells(Rows.Count, "A").End(xlUp).Row
      DligDest = wsDest.Cells(Rows.Count, "A").End(xlUp).Row

      wsSource.Range("A2:X" & DligSource).Copy wbDest.Worksheets("BDD").Range("A" & DligDest)
      ''        wsSource.Copy after:=wbDest.Worksheets(1)

      Application.DisplayAlerts = False
      wbSource.Close
      Application.DisplayAlerts = True

      '            fso.moveFile myPath & myFile, myDest & myFile

      MyFile = Dir
   Loop

   CreateObject("WScript.Shell").Run "mshta.exe vbscript:close(CreateObject(""WScript.Shell"").Popup(""ImportBDD terminé"",1,""test""))"

   Set wsDest = Nothing: Set wsSource = Nothing
   Set wbDest = Nothing: Set wbSource = Nothing

End Sub

ric

Bonsoir,

Merci Ric pour ta contribution, c'est juste nickel

Problème Résolu.

Leakim

ric