XL 2013 Macro export vers .txt

Leché

XLDnaute Junior
Bonjour,

Je souhaiterai mettre en place une macro permettant de faire ceci :

J’ai un fichier Excel nommée « FDS », dans ce fichier il y a plusieurs onglets dont :
  • Un onglet nommé « X »
  • Un onglet nommé « Y »
Pour ces deux onglets, je souhaiterai exporter dans deux fichiers .txt différents , (nommé de la même façon que les noms des onglets) l’ensemble des valeurs de la colonne F (A partir de la ligne 7 jusqu’à la dernière ligne non-vide)

Soit un fichier .txt nommé Y, reprenant l’ensemble des valeurs de la colonne F de l’onglet Y (à partir de la 7eme ligne)

Et un fichier .txt nommé X, reprenant l’ensemble des valeurs de la colonne F de l’onglet X (à partir de la 7eme ligne)

Cette macro sera lancée depuis un fichier Excel « vierge » (juste ouvert pour lancer la macro) ciblant donc le fichier excel « FDS » (qui sera dans le même dossier)
Les deux fichier .txt seront enregistrer dans le même fichier que FDS et le fichier vierge.

Si vous avez un bout de code pour commencer :)

Merci d'avance pour vos retour,

Bonne journée
 
Solution
VB:
Sub test()
With Workbooks.Open(ThisWorkbook.Path & "\FDS.xlsm")  'Ouvre le Fichier Source à voir
   FichierTxt .Sheets("30x2"), ThisWorkbook.Path & "\30x2.txt"
   FichierTxt .Sheets("35x2"), ThisWorkbook.Path & "\35x2.txt"
   .Close
End With
End Sub
Sub FichierTxt(Onglet As Worksheet, Txt As String)
Dim F As Long
F = FreeFile
  With Onglet
    Enrgt = ""
    For Each C In .Range("F7", .Cells(.Rows.Count, "F").End(xlUp))
     If Not C.EntireRow.Hidden And CStr(C) <> "" Then
        If Enrgt <> "" Then Enrgt = Enrgt & vbCrLf
            Enrgt = Enrgt & C.Value
            End If
    Next C
  End With
Open Txt For Append As #F
    Print #F, Enrgt
Close #F
End Sub

dysorthographie

XLDnaute Accro
perso je dis que le trop c'est comme le pas assez (quand c'est trop on sais plus quoi en faire)
alors que si on respecte le " fait comme ça doit être fait" la réponse t'a été donné en page 1 par Robert
j'imagine le débutant qui viens de faire connaissance avec excel vba
purée de manon!!!!se taper 4 pages pour au final ne pas savoir ce qui est vraiment propre ou pas
purée je suis sur celui là retourne sur une game boy

LOL
allez salut les artistes 🤣 🤣 🤣 🤣
rendons à danielco ce qui est à danielco!
 

patricktoulon

XLDnaute Barbatruc
re
Bonjour à Patrick ! Toujours aussi pressé Lol
bonjour @ChTi160 non pas du tout au contraire même j'ai suivi de loin
mais quand c'est absurde ça peut être rigolo mais trop absurde ça reste absurde
moi ce qui me fait marrer c'est que maintenant on a le message 1(la demande) en top de page (quelque soit la page)
autrement dit plus d'excuses le sujet ne se perd plus au fil des pages

Si vous avez un bout de code pour commencer

heu.. je me marre 🤣 🤣 🤣 🤣 🤣 🤩🥳😜
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
Bonjour,

Je souhaiterai mettre en place une macro permettant de faire ceci :

J’ai un fichier Excel nommée « FDS », dans ce fichier il y a plusieurs onglets dont :
  • Un onglet nommé « X »
  • Un onglet nommé « Y »
Pour ces deux onglets, je souhaiterai exporter dans deux fichiers .txt différents , (nommé de la même façon que les noms des onglets) l’ensemble des valeurs de la colonne F (A partir de la ligne 7 jusqu’à la dernière ligne non-vide)

Soit un fichier .txt nommé Y, reprenant l’ensemble des valeurs de la colonne F de l’onglet Y (à partir de la 7eme ligne)

Et un fichier .txt nommé X, reprenant l’ensemble des valeurs de la colonne F de l’onglet X (à partir de la 7eme ligne)

Cette macro sera lancée depuis un fichier Excel « vierge » (juste ouvert pour lancer la macro) ciblant donc le fichier excel « FDS » (qui sera dans le même dossier)
Les deux fichier .txt seront enregistrer dans le même fichier que FDS et le fichier vierge.

Si vous avez un bout de code pour commencer :)

Merci d'avance pour vos retour,

Bonne journée
ouais ok
j'en rajoute une couche
VB:
Sub test()
    Dim Wbk As Workbook, tbl(1 To 2), NM, i&, x&,chemin$
    chemin = ThisWorkbook.Path & "\"
    Set Wbk = Workbooks.Open(chemin & "FDS.xlsx")
    NM = Array("Feuil1", "feuil2")    'arranger les noms des feuilles
    tbl(1) = Application.Index(Wbk.Sheets(NM(0)).Range("F7", Wbk.Sheets(NM(0)).Cells(Rows.Count, "F").End(xlUp)).Value, 0, 1)
    tbl(2) = Application.Index(Wbk.Sheets(NM(1)).Range("F7", Wbk.Sheets(NM(1)).Cells(Rows.Count, "F").End(xlUp)).Value, 0, 1)
    For i = 0 To UBound(NM)
        x = FreeFile
        Open chemin & NM(i) & ".txt" For Output As #x: Print #x, Join(tbl(i + 1), vbCrLf): Close #x
    Next i
wbk.close
End Sub
😁
 

job75

XLDnaute Barbatruc
Bonjour à tous,

Je ne comprends vraiment pas que sur un problème aussi simple on en soit à 65 posts !!!

En tout cas pour le problème posé au post #1.

Téléchargez les fichiers joints dans le même dossier et exécutez la macro du bouton :
VB:
Sub Fichiers_TXT()
Dim chemin$, w As Worksheet, P As Range, tablo
chemin = ThisWorkbook.Path & "\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà créé
With Workbooks.Open(chemin & "FDS.xlsx") 'nom du fichier à adapter
    For Each w In .Sheets(Array("X", "Y")) 'noms des feuilles à adapter
        w.Activate 'activation nécessaire
        If w.FilterMode Then w.ShowAllData 'si la feuille est filtrée
        Set P = Intersect(w.Columns(6), w.Range("F7:F" & w.Rows.Count), w.UsedRange)
        If Not P Is Nothing Then
            tablo = P.Resize(, 2) 'mémorise les valeurs, au moins 2 éléments
            w.Cells.Delete 'RAZ
            w.Cells(1).Resize(UBound(tablo)) = tablo 'restitution
            .SaveAs chemin & w.Name, xlText 'fichier .txt
        End If
    Next
    .Close False
End With
End Sub
A+
 

Pièces jointes

  • Fichiers TXT(1).xlsm
    18.4 KB · Affichages: 14
  • FDS.xlsx
    9.4 KB · Affichages: 3

job75

XLDnaute Barbatruc
Il vaut mieux ce fichier (2) si l'une des feuilles "X" ou "Y" est vide :
VB:
Sub Fichiers_TXT()
Dim chemin$, w As Worksheet, P As Range, tablo
chemin = ThisWorkbook.Path & "\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà créé
With Workbooks.Open(chemin & "FDS.xlsx") 'nom du fichier à adapter
    For Each w In .Sheets(Array("X", "Y")) 'noms des feuilles à adapter
        w.Activate 'activation nécessaire
        If w.FilterMode Then w.ShowAllData 'si la feuille est filtrée
        Set P = Intersect(w.Columns(6), w.Range("F7:F" & w.Rows.Count), w.UsedRange)
        If Not P Is Nothing Then
            tablo = P.Resize(, 2) 'mémorise les valeurs, au moins 2 éléments
            w.Cells.Delete 'RAZ
            w.Cells(1).Resize(UBound(tablo)) = tablo 'restitution
        Else
            w.Cells.Delete 'RAZ
        End If
        .SaveAs chemin & w.Name, xlText 'fichier .txt
    Next
    .Close
End With
End Sub
 

Pièces jointes

  • Fichiers TXT(2).xlsm
    18.8 KB · Affichages: 1
  • FDS.xlsx
    9.4 KB · Affichages: 1

patricktoulon

XLDnaute Barbatruc
re
pardon autant pour moi @ChTi160 il faut transposer
avec tout ça je fait des co......es
VB:
Sub test()
    Dim Wbk As Workbook, tbl(1 To 2), NM, i&, x&,chemin$
    chemin = ThisWorkbook.Path & "\"
    Set Wbk = Workbooks.Open(chemin & "FDS.xlsx")
    NM = Array("Feuil1", "feuil2")    'arranger les noms des feuilles
    tbl(1) = Application.transpose(Application.Index(Wbk.Sheets(NM(0)).Range("F7", Wbk.Sheets(NM(0)).Cells(Rows.Count, "F").End(xlUp)).Value, 0, 1))
    tbl(2) = Application.transpose(Application.Index(Wbk.Sheets(NM(1)).Range("F7", Wbk.Sheets(NM(1)).Cells(Rows.Count, "F").End(xlUp)).Value, 0, 1))
    For i = 0 To UBound(NM)
        x = FreeFile
        Open chemin & NM(i) & ".txt" For Output As #x: Print #x, Join(tbl(i + 1), vbCrLf): Close #x
    Next i
wbk.close
End Sub
 

ChTi160

XLDnaute Barbatruc
Re
Arff après on dit pourquoi faire Compliqué quand on peut faire simple Lol
Dans le Post de Job75 #68 comme celui de Patrick #69
je ne vois pas ou l'on tient compte des cellules Vide Ou masquées qu'il ne faut pas transférer !
Mais on va m'expliquer Lol
Merci Patrick !
jean marie
 
Dernière édition:

job75

XLDnaute Barbatruc
Oui le demandeur à souhaité évincer les lignes vide ainsi que les lignes Hidden
Alors on rajoute une couche, utilisez ce fichier (3) :
VB:
Sub Fichiers_TXT()
Dim chemin$, w As Worksheet, P As Range, tablo
chemin = ThisWorkbook.Path & "\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà créé
On Error Resume Next
With Workbooks.Open(chemin & "FDS.xlsx") 'nom du fichier à adapter
    Workbooks.Add 'document auxiliaire vierge
    For Each w In .Sheets(Array("X", "Y")) 'noms des feuilles à adapter
        w.Rows("1:6").Hidden = True
        With Intersect(w.Columns(6), w.UsedRange)
            .SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True 'masque les cellules vides
            .Copy
        End With
        [A1].PasteSpecial xlPasteValues 'collage spécial-Valeurs
        Application.CutCopyMode = 0
        ActiveWorkbook.SaveAs chemin & w.Name, xlText 'fichier .txt
        Cells.Clear 'RAZ
    Next
    ActiveWorkbook.Close False
    .Close False
End With
End Sub
 

Pièces jointes

  • Fichiers TXT(3).xlsm
    20.4 KB · Affichages: 2
  • FDS.xlsx
    10.7 KB · Affichages: 2
Dernière édition:

Discussions similaires

Réponses
6
Affichages
263
Réponses
2
Affichages
222
Réponses
13
Affichages
474