Ecrasement dernière ligne fichier txt [Résolu/Fermé]

Signaler
-
 Laurene -
Bonjour,

Je sais que ce forum est assez ancien mais je tente tout de même ma chance...
J'ai essayé le module proposé et il fonctionne très bien à un tout petit détail près, la dernière ligne de chaque fichier txt est écrasée et remplacée par la première ligne du fichier txt suivant. Cela le fait systématiquement sauf bien sûr pour le tout dernier fichier.
Est-ce normal? Suis-je la seule à avoir ce problème?
Je précise que j'ai de très petites bases en VBA alors il est fort probable que le problème vienne de moi.

Merci d'avance de votre aide,

Laurène

1 réponse

Messages postés
15432
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
27 novembre 2020
1 409
Bonjour,

Je sais que ce forum est assez ancien
Ou est le problème???????????

J'ai essayé le module proposé
Certes, certes, mais lequel ??
Bonjour,

Pardon j'ai trouvé le module en question dans cette discussion :
https://forums.commentcamarche.net/forum/affich-33369340-fusionner-plusieurs-fichiers-txt-en-un-seul-onglet-xsl
J'ai testé le dernier module proposé et il fonctionne sauf que chaque "import" d'un nouveau fichier txt écrase la dernière ligne du précédent.
Avez-vous la même chose?
Merci d'avance pour votre retour,

Laurène
Messages postés
7099
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
29 novembre 2020
579
Bonjour,

comme ceci:

voir commentaire modification, cela prenait la dernière ligne remplie, en mettant +1 c'est le ligne en dessous

 Sub Copier_Plusieurs_Fichiers_Txt()
    Dim NomFich, Wbk As Workbook, i As Integer, mavar As Variant, DL_Sh1 As Long, DL As Long
    
        Application.ScreenUpdating = False
        
        Set Wbk = ThisWorkbook
        NomFich = Application.GetOpenFilename(FileFilter:="Fichier texte(*.txt),*.txt", Title:="Sélectionner les fichiers", ButtonText:=mavar, MultiSelect:=True)
        
        If IsArray(NomFich) Then
            For i = LBound(NomFich, 1) To UBound(NomFich, 1)
                If NomFich(i) <> "Faux" Then
                    'ouverture fichiers txt
                    Workbooks.OpenText Filename:=NomFich(i), Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, Semicolon:=True, DecimalSeparator:="."
                    DoEvents
                    
                    'traitement
                    With Wbk
                        Sheets(1).Copy After:=.Sheets(.Sheets.Count)
                        DoEvents
                        If WorksheetFunction.CountA(.Sheets(1).Columns(1)) = 0 Then
                            DL_Sh1 = 1
                        Else
                            DL_Sh1 = .Sheets(1).Columns(1).Find("*", , , , , xlPrevious).Row + 1' modification
                        End If
                        DL = .Sheets(.Sheets.Count).Columns(1).Find("*", , , , , xlPrevious).Row
                        .Sheets(.Sheets.Count).Range("A1:Z" & DL).Copy .Sheets(1).Range("A" & DL_Sh1)
                        Application.DisplayAlerts = False
                        .Sheets(.Sheets.Count).Delete
                        Application.DisplayAlerts = True
                    End With
                    
                    'fermeture fichiers txt
                    NomFich(i) = Split(NomFich(i), "\")(UBound(Split(NomFich(i), "\")))
                    With Workbooks(NomFich(i))
                        .Close False
                    End With
                    DoEvents
                End If
            'suivant
            Next i
        Else
            MsgBox "Aucun fichier sélectionné."
        End If
        'FIN
        Sheets(1).Select
    End Sub


voilà
Bonjour cs_Le Pivert,

Merci beaucoup pour la correction, c'était effectivement un petit détail mais qui change tout!
Bonne journée,

Laurène