Ecrasement dernière ligne fichier txt

Résolu
Laurene -  
 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

A voir également:

1 réponse

Réponse 1 / 1
f894009 Messages postés 17413 Statut Membre 1 715
 
Bonjour,

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

J'ai essayé le module proposé
Certes, certes, mais lequel ??
0
Laurne
 
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
0
cs_Le Pivert Messages postés 8437 Statut Contributeur 729
 
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à
0
Laurene
 
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
0