Separation csv en plusieurs cellules dans la meme ligne

Fermé
titi - 14 juin 2019 à 14:13
 titi - 17 juin 2019 à 18:24
Bonjour
encore moi le debutant vba...;)
j'ai une macro pour ouvrir un fichier csv de mon choix
je souhaite soit l'ouvrir ou pas, copier les données d'une plage de cellules en csv et les remettre dans mon fichier sous format cellules dans la mème ligne.
mon code de depart d'ouverture fichier ci dessous:

Sub importerunefeuillededebit2020()
Dim ret As String
'Determine plage plateau
ret = Application.GetOpenFilename
ChDir _
"Q:\4_REPERTOIRE DES AFFAIRES"

'ret = Application.GetOpenFilename("DAT Files (*.dat), *.dat") 'Avec Filtre sur des fichier avec extension DAT
Workbooks.Open Filename:=ret

Range("A1:K56").Select
Selection.Copy
Windows("MASSON VERSION 20.20 essai thierry defilement chant.xltm").Activate
Range("A4").Select
ActiveSheet.Paste
End Sub

mon fichier csv :
cloison B G Charpente A;2000;1000;19;1;U999-ST2-M19-EG;;;;;
mon resultat souhaité; separer chaque ensemble dans une cellule de la meme ligne
cloison B G Charpente A 2000 1000 19 1 U999-ST2-M19-EG
merci de votre aide
cordialement
thierry
A voir également:

1 réponse

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
14 juin 2019 à 15:49
Bonjour,
Devrait aller
    Workbooks.OpenText Filename:=ret, DataType:=xlDelimited, Semicolon:=True
0
bonsoir,
j'ai refais une bout de code mais apres avoir importer les cellules, les coller au bon endroit.. le code pour decaler mes données ne fonctionnent pas ..(
merci de votre aide
cordialement
Titi
Sub importerunefeuillededebit2020()
Dim ret As String
'Determine plage plateau
ret = Application.GetOpenFilename
ChDir _
"Q:\4_REPERTOIRE DES AFFAIRES"

'ret = Application.GetOpenFilename("DAT Files (*.dat), *.dat") 'Avec Filtre sur des fichier avec extension DAT
Workbooks.Open Filename:=ret
Workbooks.OpenText Filename:=ret, DataType:=xlDelimited, Semicolon:=True
Range("A1:K56").Select
Selection.Copy

Windows("Feuille de debit automatisee 20.20.xltm").Activate
Range("A4").Select
ActiveSheet.Paste

If Fichiercsv = False Then Exit Sub

Ncsv = FreeFile
Open Fichiercsv For Input As #Ncsv

icsv = 0
Do While Not EOF(1)
Line Input #Ncsv, Contenucsv
icsv = icsv + 1

Tablecsv = Split(Contenucsv, ";")
For jcsv = 0 To UBound(Tablecsv)
Cells(icsv, jcsv + 1).Value = Replace(Tablecsv(jcsv), ",", ".")
Next jcsv

Loop

Close #Ncsv


End Sub
0