Importer les données d'un autre fichier

Chaque jour des journées comptables sous format excel sont générées de notre S.I. le fichier généré est mis dans un répertoire de partage, le fichier peut varier selon le nombre d'opération.

le seul avantage c'est que les colonnes et le type du contenu est le même (14 colonnes)...et aussi le nom du fichier qui est sous forme ETAT_Compta_date de la journée (exemple: ETAT_Compta_20191020.csv , ETAT_Compta_20191021.csv....) je vais appeler ce fichier source.

de ce fichier source je vais récupérer uniquement 9 colonnes selon certains critères

Normalement ce que je fait:

1- j'ouvre le fichier source présent dans le répertoire : D:\AUDIT\Etat\Compta

2- je copie tout...je le colle dans la feuille BD_CLMT

3 - j’exécute la macro et mes données sont transférés vers la feuille CLMT et la base est ensuite effacée

ce que je veux faire

Une fois le fichier ouvert la macro m'importe directement mes données vers la feuille CLMT

cad sauter la phase 2 et ne plus faire le copier/coller pour ne plus utiliser la feuille de transit BD_CLMT

je vous met le fichier en PJ les 2 fichiers avec un exemple de tableau source

D'avance merci pour vos aide

RE-

L'agence est en quelle colonne de ton tableau source ?

RE-

L'agence est en quelle colonne de ton tableau source ?

Ah j'ai pas fait attention, j'ai corrigé le 1er fichier

dans le fichier source, l'Agence est dans la colonne F

Regarde si la réponse est celle attendue ...

Sub Importer_base_CLMT()
Dim col1%, col2%, a, ub%, util, d As Object, i&, tablo, resu(), j%, v As Variant, n&
Dim f As Variant, temp
col1 = 1: col2 = 6 'à adapter
a = Array(2, 3, 4, 6, 7, 8, 10, 11, 12) 'numéros des colonnes à copier
ub = UBound(a)

'---lecture du fichier csv---
f = Application.GetOpenFilename("csv Files (*.csv), *.csv")
If f = False Then Exit Sub
Workbooks.Open Filename:=f, LOCAL:=True
f = Dir(f)
tablo = [A1].CurrentRegion.Resize(, a(ub))
Workbooks(f).Close

'---mémorise les utilisateurs---
util = Sheets("Utilisateurs").[A4].CurrentRegion.Resize(, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(util)
    d(UCase(util(i, 1)) & Chr(1) & util(i, 2)) = ""
Next i

'---tableau des résultats---
'tablo = Sheets("BD_CLMT").[A1].CurrentRegion.Resize(, a(ub))
ReDim resu(UBound(tablo), ub) 'base 0
For i = 2 To UBound(tablo)
    If d.exists(UCase(tablo(i, col1)) & Chr(1) & tablo(i, col2)) Then
        For j = 0 To ub
            v = tablo(i, a(j))
            If IsNumeric(v) Then resu(n, j) = CDbl(v) Else resu(n, j) = v
        Next j
        n = n + 1
    End If
Next i

'---restitution---
With Sheets("CLMT")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    If n Then .Cells(.Rows.Count, 4).End(xlUp)(2).Resize(n, ub + 1) = resu
End With

End Sub

Bonjour Steelson

je trouve pas les mots pour te remercier...mais vraiment vous m'avez rendu un grand service.

Juste une question...parce que je vais copier cette macro dans les fichiers de mes collègues (utilisateurs) qui seront surement heureux

Juste une question: je vois que dans la macro que vous avez utilisé sheet BD_CLMT (elle est où la feuille, je ne la vois pas dans le classeur )

Autre chose (c'est juste une option c pas nécessaire), Voir nouvelle pièce jointe, si vous pouvez améliorer la macro

dans la colonne J du fichier source contiennent les matricules de tout les utilisateurs (nouveaux et ex) ...je veux au moment de l'import qu'il élimine ceux des anciens utilisateurs (leurs matricules sont énumérés dans la colonne I de la feuille utilisateur (ex utilisateurs)

Laisser tomber si ça va vous prendre bcp de temps.....car ce que vous avez fait est très largement suffisant

Juste une question: je vois que dans la macro que vous avez utilisé sheet BD_CLMT (elle est où la feuille, je ne la vois pas dans le classeur )

Non, j'ai mis la ligne en commentaire en attendant ta réponse, tu peux l'effacer.

Elel est remplacée par un paragraphe juste au -dessus :

'---lecture du fichier csv---
f = Application.GetOpenFilename("csv Files (*.csv), *.csv")
If f = False Then Exit Sub
Workbooks.Open Filename:=f, LOCAL:=True
f = Dir(f)
tablo = [A1].CurrentRegion.Resize(, a(ub))
Workbooks(f).Close

C'est la seule modif que j'ai faite (le temps de bien comprendre la macro qui est très bien écrite).


Autre chose (c'est juste une option c pas nécessaire), Voir nouvelle pièce jointe, si vous pouvez améliorer la macro

dans la colonne J du fichier source contiennent les matricules de tout les utilisateurs (nouveaux et ex) ...je veux au moment de l'import qu'il élimine ceux des anciens utilisateurs (leurs matricules sont énumérés dans la colonne I de la feuille utilisateur (ex utilisateurs)

je vais y jeter un œil (pas tout de site ...)

A tester ...

y débocage à ce niveau

1572606788 capture1001 1572606788 capture1000

Est-ce que les ex-utilisateurs sont en numérique comme l'exemple fourni ?

Est-ce qu'ils commencent bien ligne 2 colonne I ?

Y a t'il autre chose en colonne I ?

Est-ce que les ex-utilisateurs sont en numérique comme l'exemple fourni ?

Est-ce qu'ils commencent bien ligne 2 colonne I ?

Y a t'il autre chose en colonne I ?

ils sont en numérique et alphanumérique

oui ils commencent bien ligne 2 colonne I

y a rien en colonne I à par les matricules

sinon, actuellement j'utilise cette macro pour les supprimer

Sub supprimer()

Dim cel As Range
Sheets("CLMT").Select
With Sheets("utilisateurs")
    For I = Cells(Rows.Count, "I").End(xlUp).Row To 1 Step -1
        Set cel = .Columns("I").Find(Cells(I, "J"))
        If Not cel Is Nothing Then
            Rows(I).Delete Shift:=xlUp
        End If
    Next
End With
End Sub

sinon ne vous déranger pas trop....je voulais juste combiner ces deux macros...sinon je vais les utiliser les 2 à la fois

ils sont en numérique et alphanumérique

ok, j'avais considéré qu'il n'étaient que numérique comme l'exemple

A tester car je n'ai pas de données alphanum dans l'exemple que tu as donné.

Sub Importer_base_CLMT()
Dim col1%, col2%, col3%, a, ub%, agent, exutil, d As Object, ex As Object, i&, tablo, resu(), j%, v As Variant, n&
Dim f As Variant, temp
col1 = 1: col2 = 6: col3 = 10 'à adapter
a = Array(2, 3, 4, 6, 7, 8, 10, 11, 12) 'numéros des colonnes à copier
ub = UBound(a)

'---lecture du fichier csv---
f = Application.GetOpenFilename("csv Files (*.csv), *.csv")
If f = False Then Exit Sub
Workbooks.Open Filename:=f, LOCAL:=True
f = Dir(f)
tablo = [A1].CurrentRegion.Resize(, a(ub))
Workbooks(f).Close

'---mémorise les agences---
agent = Sheets("Utilisateurs").[A4].CurrentRegion.Resize(, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(agent)
    d(UCase(agent(i, 1)) & Chr(1) & agent(i, 2)) = ""
Next i

'---mémorise les utilisateurs anciens---
exutil = Sheets("Utilisateurs").Range("I2:I" & Sheets("Utilisateurs").Cells(Rows.Count, "I").End(xlUp).Row)
Set ex = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(exutil)
    If exutil(i, 1) <> "" Then ex((exutil(i, 1))) = ""
Next i
Debug.Print "---"

'---tableau des résultats---
ReDim resu(UBound(tablo), ub) 'base 0
For i = 2 To UBound(tablo)
    If d.exists(UCase(tablo(i, col1)) & Chr(1) & tablo(i, col2)) And ex.exists(tablo(i, col3)) = False Then
        For j = 0 To ub
            v = tablo(i, a(j))
            If IsNumeric(v) Then resu(n, j) = CDbl(v) Else resu(n, j) = v
        Next j
        n = n + 1
    End If
Next i

'---restitution---
With Sheets("CLMT")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    If n Then .Cells(.Rows.Count, 4).End(xlUp)(2).Resize(n, ub + 1) = resu
End With

End Sub

oui ça marche parfaitement

juste une erreur .....peut être vous avez utilisé l'ancien code qui commençait le traitement à partir de la deuxième ligne de la feuille BD_CMLT...et dans votre macro la première ligne du fichier source n'est prise en compte

En effet, je n'avais pas percuté sur ce point

Essaie de mettre 1 au lieu de 2

For i = 1 To UBound(tablo)

et dis moi si c'est ok

ola ola c superbe....tout marche nickel même les matricules alphanumériques ..... MERCI INFINIMENT

Re

Bonjour....est ce qu'on peut avoir un msgbox nous renseignant sur le nombre de lignes importées ?

Merci de votre aide

A la fin de la macro, ajoute

MsgBox n & " lignes importées !"

avant

End Sub

10/10 .... Merci beaucoup

Rechercher des sujets similaires à "importer donnees fichier"