Importation des données d'un fichier txt versexcel en utilisant une macro

D

DadouK

XLDnaute Nouveau
Bonjour,
'ai deja un formulaire html qui doit etre rempli apres avoir cliquer sur valider j'aurai un fichier txt alimenté derriere avec toutes les informations requises , et en cliquan sur la macro je recupere toutes les données sur excel : mon probleme c'est que j'ai besoin de garder sur excel plusieurs lignes car il me garde que la derniere ligne et je ne sais pas comment ajouter ce controle
je vx mets le code et je vous remercies pour vos reponses
Code: 
Sub Macro5()

' Macro5 permettant d'importer les données du fichier vers l'application
' Macro enregistrée le 16/06/2009 par S596606

Dim ExDate0 As String
Dim ExDate10 As String
Dim ExDate20 As String

Dim ExDate1 As String
Dim ExDate11 As String
Dim ExDate21 As String

Dim ExDate2 As String
Dim ExDate12 As String
Dim ExDate22 As String

Dim E1 As String
Dim E2 As String
Dim E3 As String
Dim E4 As String
Dim E5 As String
Dim E6 As String
Dim E7 As String
Dim E8 As String
Dim E10 As String
Dim E11 As String
Dim E12 As String
Dim E13 As String
Dim E14 As String
Dim E15 As String
Dim E16 As String
Dim E17 As String
Dim E18 As String
Dim E19 As String
Dim E20 As String
Dim E21 As String
Dim E22 As String
Dim E23 As String
Dim E24 As String
Dim E25 As String
Dim E26 As String
Dim E27 As String
Dim E28 As String
Dim E29 As String

Dim E30 As String
Dim E31 As String
Dim E32 As String
Dim E33 As String
Dim E34 As String
Dim E35 As String
Dim E36 As String
Dim E37 As String
Dim E38 As String
Dim E39 As String
Dim E40 As String
Dim E41 As String
Dim E42 As String
Dim E43 As String


Open "D:\Documents and Settings\fichie.txt" For Input As 5

 '
 
 nbtour = 0
 While EOF(5) = False
 Line Input #5, lignesuivante
 If (InStr(lignesuivante, "pppp") = 1) Then nbtour = nbtour + 1
 Wend
 Close #5
    'MsgBox (nbtour)
    
    
    Sheets("Proposition").Select
    Rows("2:31").Select
    Selection.Delete Shift:=xlUp
    Range("A6").Select
    Workbooks.OpenText Filename:= _
        "D:\Documents and Settings\S601436\Desktop\Test\oasis\fichie.txt", Origin:= _
        xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
     
   
        
     
     
     
    ''éliminer le décalage de cellules''''
    Windows("fichie.txt").Activate
    Range("A1").Select
    Selection.Delete Shift:=xlUp
    ''''''''''''''''''''''''''''''''''''''
        
    pos1 = 17
    pos2 = 18
    pos3 = 19
    
    pos = 0
    
    While (nbtour >= 0)
    
    'récupération des date dans des variables
        Dim Exemple As Date
        Dim exemple1 As Date
        Dim Exemple2 As Date
        
         If Range("A" & pos1).Value <> "" Then
        Exemple = Format(Range("A" & pos1), "mm/dd/yyyy")
        End If
        If Range("A" & pos2).Value <> "" Then
        exemple1 = Format(Range("A" & pos2), "mm/dd/yyyy")
        End If
        If Range("A" & pos3).Value <> "" Then
        Exemple2 = Format(Range("A" & pos3), "mm/dd/yyyy")
       
        End If

      
        
        'ExDate0 = Left(Exemple, 2)
        'ExDate10 = Mid(Exemple, 4, 2)
        'ExDate20 = Right(Exemple, 4)
        
       
        
        'ExDate1 = Left(exemple1, 2)
        'ExDate11 = Mid(exemple1, 4, 2)
        'ExDate21 = Right(exemple1, 4)
         
               
        'ExDate2 = Left(Exemple2, 2)
       ' ExDate12 = Mid(Exemple2, 4, 2)
    
    
    
    decal = 2 + pos
    
    'Windows("fichie.txt").Activate
   E1 = Range("A1").Value
    E2 = Range("A2").Value
    E3 = Range("A3").Value
    E4 = Range("A4").Value
    E5 = Range("A6").Value
    E6 = Range("A5").Value
    E7 = Range("A7").Value
    E8 = Range("A8").Value
    E9 = Range("A9").Value
    E10 = Range("A10").Value
    E11 = Range("A11").Value
    E12 = Range("A12").Value
    E13 = Range("A13").Value
    E14 = Range("A14").Value
    E15 = Range("A15").Value
    
       
    E16 = Range("A16").Value
    E17 = Range("A20").Value
    E18 = Range("A21").Value
    E19 = Range("A22").Value
    E20 = Range("A23").Value
    E21 = Range("A24").Value
    E22 = Range("A25").Value
    E23 = Range("A26").Value
    E24 = Range("A27").Value
    E25 = Range("A28").Value
    E26 = Range("A29").Value
    E27 = Range("A30").Value
    E28 = Range("A31").Value
    E29 = Range("A33").Value
    E30 = Range("A32").Value
    E31 = Range("A33").Value
    E32 = Range("A34").Value
    E33 = Range("A35").Value
    E34 = Range("A36").Value
    E35 = Range("A37").Value
    E36 = Range("A38").Value
    E37 = Range("A39").Value
    E38 = Range("A40").Value
    E39 = Range("A41").Value
    E40 = Range("A42").Value
    E41 = Range("A43").Value
    E42 = Range("A44").Value
    E43 = Range("A45").Value
    
    Application.WindowState = xlMinimized
    Windows("Oasis v1 1.xls").Activate
    Range("D" & decal).Value = E1
    Range("E" & decal).Value = E2
    Range("F" & decal).Value = E3
    Range("G" & decal).Value = E4
    Range("I" & decal).Value = E5
    Range("H" & decal).Value = E6
    Range("J" & decal).Value = E7
    Range("K" & decal).Value = E8
    Range("L" & decal).Value = E9
    Range("M" & decal).Value = E10
    Range("N" & decal).Value = E11
    Range("O" & decal).Value = E12
    Range("P" & decal).Value = E13
    Range("Q" & decal).Value = E14
    Range("Q" & decal).Value = E15
    Range("R" & decal).Value = E16
    Range("AA" & decal).Value = E17
    Range("AB" & decal).Value = E18
    Range("AC" & decal).Value = E19
    Range("AD" & decal).Value = E20
    Range("AE" & decal).Value = E21
    Range("AF" & decal).Value = E22
    Range("AG" & decal).Value = E23
    Range("AH" & decal).Value = E24
    Range("AI" & decal).Value = E25
    Range("AJ" & decal).Value = E26
    Range("AK" & decal).Value = E27
    Range("AL" & decal).Value = E28
    Range("AM" & decal).Value = E29
    
    
    
     If (nbtour > 0) Then
           
        Range("S" & decal).Value = Day(Exemple)
        Range("T" & decal).Value = Month(Exemple)
        Range("U" & decal).Value = Year(Exemple)
        
        Range("V" & decal).Value = Day(exemple1)
        Range("W" & decal).Value = Month(exemple1)
        Range("X" & decal).Value = Year(exemple1)
        
        Range("Y" & decal).Value = Day(Exemple2)
        Range("Z" & decal).Value = Month(Exemple2)
        
        
        Range("AM" & decal).Value = E30
        Range("AN" & decal).Value = E31
        Range("AO" & decal).Value = E32
        Range("AP" & decal).Value = E33
        Range("AQ" & decal).Value = E34
        Range("AR" & decal).Value = E35
        Range("AS" & decal).Value = E36
        Range("AT" & decal).Value = E37
        Range("AU" & decal).Value = E38
        Range("AV" & decal).Value = E39
        Range("AW" & decal).Value = E40
        Range("AX" & decal).Value = E41
        Range("CB" & decal).Value = E42
        Range("CC" & decal).Value = E43
    End If
    'Windows("fichie.txt").Activate
    
    'Range("A34").Select
    'Application.CutCopyMode = False
    'Selection.Copy
    'Windows("Oasis v1 1.xls").Activate
    'Windows("fichie.txt").Activate
    'Windows("Oasis v1 1.xls").Activate
    
    Windows("fichie.txt").Activate
    Range("A1:B46").Select
    Selection.Delete Shift:=xlUp
    
    nbtour = nbtour - 1
    pos = pos + 1
     'if nof((D:\Documents and Settings\S601436\Desktop\Test\oasis\fichie.txt))
    Wend
   
    Application.DisplayAlerts = False

    ActiveWorkbook.SaveAs Filename:= _
       "D:\Documents and Settings\fichie.txt", FileFormat:=xlText, _
       CreateBackup:=True
        Application.DisplayAlerts = False
     ActiveWorkbook.Saved = True
     ActiveWindow.Close
    
    Windows("Oasis v1 1.xls").Activate
    Sheets("Proposition").Select
    Range("G2").Select
    
    Sheets("Application").Select
    Application.WindowState = xlMaximized
    
   
    
End Sub
 
Trier par date Trier par votes
D

DadouK

XLDnaute Nouveau
Re : Importation des données d'un fichier txt versexcel en utilisant une macro

Bonjour ,

je vous mets le fichier txt !!
test.jpg
Merci d'avance
 

Pièces jointes

  • test.jpg
    test.jpg
    29.5 KB · Affichages: 144
  • test.jpg
    test.jpg
    29.5 KB · Affichages: 145
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
360
M@xu3L
M
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
567
Vermithor
V
V
  • Résolu(e)
XL 2016 Exportation au format PDF à l'aide d'une macro : erreur 1004 'Document non enregistré'
Réponses
14
Affichages
527
Phil69970
Phil69970
G
  • Question
Microsoft 365 Réduire la taille de la macro ?
Réponses
9
Affichages
600
Staple1600
Staple1600
Q
  • Résolu(e)
Microsoft 365 Exécutions directes différentes vs "pas à pas"
Réponses
2
Affichages
218
Quentin2106
Q
Electron24
  • Résolu(e)
Microsoft 365 Save qu'une feuille d'un classeur
Réponses
4
Affichages
516
Electron24
Electron24
S
  • Question
XL 2013 Ajouter un lien hypertexte dans la macro qui envoi une invitation outlook
Réponses
3
Affichages
584
Sbed
S
H
  • Question
Microsoft 365 Besoin aide : Erreur code macro . Problème est résolu
Réponses
7
Affichages
636
heart clean
H
F
  • Résolu(e)
XL 2019 Enregistrer sous la feuille active dans répertoire du fichier père en vba
2
Réponses
23
Affichages
684
Fabrice16ct
F
C
  • Résolu(e)
Autres gestion bibliothèque avec lecteur code barre
2
Réponses
21
Affichages
2 K
Chatron
C

Membres actuellement en ligne

7 membres et 55 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 215
Messages
2 086 330
Membres
103 188
dernier inscrit
evebar