XL 2019 récupérer une donnée d'un fichier csv pour le copier vers un autre

Hutchy33

XLDnaute Nouveau
Bonjour,
Je souhaite faire un truc tout basique certainement pour certains mais j'ai pas le résultat voulu.
Je souhaite récupérer le contenu d'une cellule d'un fichier csv pour le copier vers une cellule sur un autre fichier.
J'ai utilisé ce code:
VB:
Sub CopierCellulesVersAutreFichier()
    Dim CheminSource As String
    Dim CheminDestination As String
    Dim FeuilleSource As Worksheet
    Dim FeuilleDestination As Worksheet
   
    ' Spécifiez le chemin complet du fichier source
    CheminSource = "C:\Users\HArnaud\Desktop\écriture form\retour résultats éval QCM\test.csv" '
   
    ' Spécifiez le chemin complet du fichier de destination
    CheminDestination = "C:\Users\HArnaud\Desktop\écriture form\retour résultats éval QCM\test qcm v3.xlsm" '
   
    ' Ouvrez le fichier source
    Workbooks.Open Filename:=CheminSource
   
    ' Spécifiez la feuille source et la feuille de destination
    Set FeuilleSource = Workbooks("test.csv").Sheets("test")
    Set FeuilleDestination = Workbooks("test qcm v3.xlsm").Sheets("resultats")
   
    ' Copiez les cellules de la feuille source vers la feuille de destination
    FeuilleSource.Range("A2").Copy FeuilleDestination.Range("B4")
   
    ' Fermez le fichier source sans enregistrer les modifications
    Workbooks("test.csv").Close SaveChanges:=False
End Sub

Je ne veux récupérer que la valeur de la cellule A2 et pourtant ça me récupère les valeurs de toutes les cellules de la ligne pour venir les copier en B4 de l'autre fichier. Je ne pige pas pourquoi .
Je vous joins les fichiers si quelqu'un à un peu de temps à y accorder s'il vous plait.
Merci beaucoup.
 
Dernière modification par un modérateur:

Eric KERGRESSE

XLDnaute Occasionnel
Bonjour,

Pour les csv, je les ouvre comme un fichier txt. Ici, j'ai supprimé les paramètres de colonnes. Lorsque vous ne savez pas récupérer un csv, vous en faites une copie et vous changez l'extension par .txt. Vous enregistrez une macro et vous faites toutes les séquences pour ouvrir votre fichier .txt.

VB:
Sub CopierCellulesVersAutreFichier()

    Dim CheminSource As String
    Dim CelluleDestination As Range
    
    
    Set CelluleDestination = Sheets("resultats").Range("B4")
    ' Spécifiez le chemin complet du fichier source
    CheminSource = ActiveWorkbook.Path & "\test.csv" '"C:\Users\HArnaud\Desktop\écriture form\retour résultats éval QCM\test.csv" '
  
    Workbooks.OpenText Filename:=CheminSource _
        , Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _
        Comma:=True, Space:=False, Other:=False, TrailingMinusNumbers:=True
    
    ActiveSheet.Range("A2").Copy Destination:=CelluleDestination
    ActiveWorkbook.Close savechanges:=False
 
    Set CelluleDestination = Nothing
 
End Sub
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

Une autre syntaxe possible
VB:
Sub test_CSV()
Dim nomFIC$, vArr
'adapter le chemin & nom fichier
nomFIC = "C:\Users\STAPLE\Documents\tests\test.csv"
Set CSV_WB = Workbooks.Open(nomFIC, Format:=2, Local:=True)
vArr = CSV_WB.Worksheets(1).UsedRange: CSV_WB.Close (0)
'recopie en B4
ActiveSheet.Cells(4, 2) = vArr(2, 1) & " " & vArr(2, 2)
End Sub
Ici dans cet exemple, on copie dans la feuille active du classeur contenant la macro

Donc faire adaptation nécessaire avec le code initial du message#1
 

job75

XLDnaute Barbatruc
Bonjour à tous,

Une autre solution :
VB:
Sub CopierCSV()
Dim chemin$, x, texte$, v$
chemin = ThisWorkbook.Path & "\test.csv"
x = FreeFile
Open chemin For Input As #x 'ouverture en lecture séquentielle
Line Input #x, texte: texte = "" '1ère ligne
If Not EOF(x) Then Line Input #x, texte 'si 2ème ligne
Close #x
If texte <> "" Then v = Split(texte, ";")(0)
ActiveSheet.[B4] = v
End Sub
Le fichier CSV doit être dans le même dossier que le fichier de la macro.

A+
 

Hutchy33

XLDnaute Nouveau
Bonjour à tous,

Une autre solution :
VB:
Sub CopierCSV()
Dim chemin$, x, texte$, v$
chemin = ThisWorkbook.Path & "\test.csv"
x = FreeFile
Open chemin For Input As #x 'ouverture en lecture séquentielle
Line Input #x, texte: texte = "" '1ère ligne
If Not EOF(x) Then Line Input #x, texte 'si 2ème ligne
Close #x
If texte <> "" Then v = Split(texte, ";")(0)
ActiveSheet.[B4] = v
End Sub
Le fichier CSV doit être dans le même dossier que le fichier de la macro.

A+
Merci Job pour ton retour, je ne comprends pas tout ton code car je n'ai surement pas ton expérience en vba mais en tout cas ton code fonctionne.
Mais tout de même je ne parviens pas à l'intégrer dans mon code actuel, je m'explique.
A l'ouverture du fichier xlsm (que je m'appelle la matrice), j'ai une macro qui s'exécute demandant de venir choisir le fichier csv à analyser (ce sont des retours de résultats d'un test QCM).
Je parviens bien à récupérer les notes pour chaque items contenu dans le csv et les afficher sous forme d'icones valider ✅ ou non valide ❌.
J'ai besoin de récupérer les informations administratives du participant d'où ma précédente question, je ne parviens pas à intégrer ton code dans celui existant!
Voici le code qui s'exécute à l'ouverture de la matrice :

VB:
Private Sub Workbook_Open()
'Dim fichier As Variant, tablo
ChDir ThisWorkbook.Path
fichier = Application.GetOpenFilename("Fichiers CSV(*.csv),*.csv") 'choix du fichier CSV
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
Range("B12:C" & Rows.Count).ClearContents 'RAZ
Workbooks.Open fichier, Local:=True
tablo = ActiveWorkbook.Sheets(1).[M1:CJ2] 'plage modifiable

ActiveWorkbook.Close
[B12].Resize(UBound(tablo, 2), 2) = Application.Transpose(tablo)
End Sub

La variable fichier je les mise en déclaration public.
Je souhaiterai récupérer aussi les infos administratives (Nom, prénom Entreprise et Poste) pour les écrire sur le fichier final avec les notes (matrice).
J'espère être assez clair, pas évident d'expliquer.
Les fichiers joins pour test.
Merci beaucoup
 
Dernière modification par un modérateur:

Hutchy33

XLDnaute Nouveau
Bonjour,
Juste pour information.
Est-ce que le fichier csv ne comporte qu'une ligne, ou à terme, comportera moult résultats d'évaluation d'un certain nombre de "candidats"?
oui effectivement à terme il peut y avoir plusieurs lignes de participant avec leurs résultats, et la macro devra créer une feuille par candidat avec leurs résultats et leurs infos administrative en haut à gauche.
 

job75

XLDnaute Barbatruc
Voici la macro adaptée à votre dernier fichier :
VB:
Private Sub Workbook_Open()
Dim fichier As Variant, plage As Range, cc%, col%, x, n, a(), texte$, s, i&
ChDir ThisWorkbook.Path
fichier = Application.GetOpenFilename("Fichiers CSV(*.csv),*.csv") 'choix du fichier CSV
If fichier = False Then Exit Sub
Set plage = [M1:CJ1]
cc = plage.Columns.Count
col = plage.Column
x = FreeFile
Open fichier For Input As #x 'ouverture en lecture séquentielle
On Error Resume Next
For n = 0 To 1
    ReDim a(1 To cc, 1 To 1)
    Line Input #x, texte
    texte = Replace(Replace(Replace(texte, "à ", "à"), "é", "è"), "è", "è") 'adapter aux besoins
    s = Split(texte, ";")
    For i = 1 To UBound(a)
        a(i, 1) = s(i + col - 2)
    Next i
    [B12].Offset(, n).Resize(UBound(a)) = a
Next n
End Sub
Pas besoin de variables Public...
 

job75

XLDnaute Barbatruc
Comme on le voit la macro du post #6 est nettement plus simple donc utiliser :
VB:
Private Sub Workbook_Open()
Dim fichier As Variant, tablo1, tablo2
ChDir ThisWorkbook.Path
fichier = Application.GetOpenFilename("Fichiers CSV(*.csv),*.csv") 'choix du fichier CSV
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
Range("B12:C" & Rows.Count).ClearContents 'RAZ
Workbooks.Open fichier, Local:=True
tablo1 = ActiveWorkbook.Sheets(1).[A1:L2] 'plage modifiable
tablo2 = ActiveWorkbook.Sheets(1).[M1:CJ2] 'plage modifiable
ActiveWorkbook.Close
[B4] = tablo1(2, 1)
[B5] = tablo1(2, 2)
[B6] = tablo1(2, 5) 'ou tablo1(2, 3) ?
[B7] = tablo1(2, 4)
[B8] = tablo1(2, 6)
[B12].Resize(UBound(tablo2, 2), 2) = Application.Transpose(tablo2)
End Sub
 

Hutchy33

XLDnaute Nouveau
Comme on le voit la macro du post #6 est nettement plus simple donc utiliser :
VB:
Private Sub Workbook_Open()
Dim fichier As Variant, tablo1, tablo2
ChDir ThisWorkbook.Path
fichier = Application.GetOpenFilename("Fichiers CSV(*.csv),*.csv") 'choix du fichier CSV
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
Range("B12:C" & Rows.Count).ClearContents 'RAZ
Workbooks.Open fichier, Local:=True
tablo1 = ActiveWorkbook.Sheets(1).[A1:L2] 'plage modifiable
tablo2 = ActiveWorkbook.Sheets(1).[M1:CJ2] 'plage modifiable
ActiveWorkbook.Close
[B4] = tablo1(2, 1)
[B5] = tablo1(2, 2)
[B6] = tablo1(2, 5) 'ou tablo1(2, 3) ?
[B7] = tablo1(2, 4)
[B8] = tablo1(2, 6)
[B12].Resize(UBound(tablo2, 2), 2) = Application.Transpose(tablo2)
End Sub
Bonjour et merci Job75 effectivement je vais partir sur ce code qui m'a l'air bien plus simple à utiliser, je vais tester!
 

Discussions similaires

Statistiques des forums

Discussions
313 197
Messages
2 096 105
Membres
106 499
dernier inscrit
mmontagu