Import données depuis plusieurs fichiers csv distincts

Bonjour,

J'ai créé un outil pour me permettre de générer un fichier qui s'appuie sur des données sources issues de fichiers csv.

Les fichiers sources csv sont du types TBCT_AAAAMMJJ_HHMMSS (exemple TBCT_20160428_141400)

Pour le moment j'ai réussi à créer une macro me permettant de récupérer des données dans ce fichier à partir d'un répertoire précis.

Mais comme j'ai plusieurs fichier sources, je ne voudrais pas multiplier les répertoires sources et mettre tous les fichiers csv dans le même répertoire.

Pour cela, je dois distinguer les fichiers sources à partir de leurs nom commençant par "TBCT" ou "CTMQ" ou "ART_SIMP" et m'assurer de prendre la dernière version en me basant sur l'incrémentation date ou compteur associée.

La macro ci-jointe me permet de trouver le fichier le plus récent, mais comment ajouter et combiner la notion de "commençant par "

Votre aide sera la bienvenue:

Sub IMPORT_DATA()

'Bloque la mise à jour de l'affichage

Application.ScreenUpdating = False

'Bloque les messages d'erreur

Application.DisplayAlerts = False

'bloque la mise à jour des calculs

Application.Calculation = xlManual

Dim Fic As Object, MemFic As String, VPath As String

Dim Fso 'As FileSystemObject

Dim SourceFolder 'As Scripting.Folder

Dim lastRow As Long, lRow As Long

Dim lastCol As Integer, iCol As Integer

' Initialisation des variables

MemFic = ""

' Définit le dossier de traitement source

Sheets("PARAM").Select

VPath = Cells(9, 2).Value

' Définit le fichier en cours

Dim nom As String

Sheets("PARAM").Select

nom = Cells(6, 2).Value

Set Fso = CreateObject("Scripting.FileSystemObject")

Set SourceFolder = Fso.GetFolder(VPath)

'Liste des fichiers du dossier sélectionné

For Each Fic In SourceFolder.Files

' Mémorise le dernier fichier selon l'ordre alphanumérique

If Fic > MemFic Then MemFic = Fic

Next Fic

Workbooks.OpenText Filename:=MemFic, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Semicolon:=True, DecimalSeparator:=",", Local:=True

'Définir le nom du fichier

nomFic = ActiveWorkbook.Name

' Test sur présence de données

If Cells.Find("*") Is Nothing Then

MsgBox "Pas de données dans fichier - fin de la procédure", vbCritical, "Erreur données"

Exit Sub

Else

'Définir N° dernière ligne

DERLIGN = Range("A1").End(xlDown).Row

'Copier données de source

Range("A1:BU" & DERLIGN).Select

Selection.Copy

'Coller données vers DATA

Windows(nom).Activate 'modifier le nom du fichier si necessaire

Sheets("DATASIP").Select

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Range("A1").Select

'fermeture fichier source

Windows(nomFic).Activate

ActiveWorkbook.Close

'Définition N° dernière ligne

Sheets("DATASIP").Select

DERLIGN2 = Range("A1").End(xlDown).Row

'import formules

Sheets("FORM").Select

Range("A2:CC2").Select

Selection.Copy

Sheets("DATAWM").Select

Range("A2:CC" & DERLIGN2).Select

Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

'Mise à jour calculs

Application.Calculation = xlAutomatic

Range("A2:CC" & DERLIGN2).Select

Selection.Copy

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Range("A1").Select

Application.CutCopyMode = False

'retour accueil

Sheets("ACCUEIL").Select

MsgBox ("IMPORT DONNEES TERMINE!")

'Débloque la mise à jour de l'affichage

Application.ScreenUpdating = True

'Débloque les messages d'erreur

Application.DisplayAlerts = True

End If

End Sub

Merci

Bonsoir,

Ci-joint une proposition à tester.

Bonne soirée

Bouben

merci Bouben,

j'ai testé et décortiqué cette solution.

mais elle ne réponds pas à mon besoin exactement car elle permet d’identifier le fichier csv le plus "récent" quelque soit le préfixe (CTMQ, TCBT, ART_SIMP) mais j'aurais besoin de le faire préfixe par préfixe et donc de compbiner deux conditions

D'abord le fichier commençant par TBCT et le plus récent, puis après le fichier commençant par ART_SIMP et le plus récent puis après le fichier commençant par CTMQ et le plus récent

Je me dis que ton code doit être utilisable mais je sèche sur l’enchaînement des conditions.

merci

Bonjour,

Effectivement, ce n'est pas ce qui était fait

Ci-joint une nouvelle version à tester, avec cette nouvelle règle.

Bonne journée

Bouben