XL 2013 Macro export vers .txt

[Leché]

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

 

[ChTi160]

Re oui j'ai vu d'où le rajout dans #58

 

[dysorthographie]

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]

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

 

[patricktoulon]

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

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]

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 :

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+

 

[patricktoulon]

re
ouais!!! c'est vrai ça !!!!!!

 

[ChTi160]

Re
ca vous etonne qu'il y ai autant de pages, comme dirait Patrick.
la réponse est en page 1
Patrick j'ai testé ton Code du Post #64 et j'ai un message d'erreur "Erreur d'exécution 5"
sur

Join(tbl(i + 1), vbCrLf)

jean marie

 

[job75]

Il vaut mieux ce fichier (2) si l'une des feuilles "X" ou "Y" est vide :

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

 

[patricktoulon]

re
pardon autant pour moi @ChTi160 il faut transposer
avec tout ça je fait des co......es

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]

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

 

[patricktoulon]

re
oui je sais pas peut être que "lignes vides" a été une condition supplémentaire évoquée par le demandeur
entre la page 1 et 5
@job75 répond correctement a la question de base avec sa méthode
LOL

 

[dysorthographie]

Oui le demandeur à souhaité évincer les lignes vide ainsi que les lignes Hidden

 

[ChTi160]

Re
il dit :

Mince, j'ai des cellules qui sont masqués (il y a un filtre) elles sont donc directement copiés avec les valeurs visibles, peut t-on les cachés elles aussi ?

c'est en feuille 3
on en rajoute une couche ? Lol
jean marie

 

[job75]

Oui le demandeur à souhaité évincer les lignes vide ainsi que les lignes Hidden

Alors on rajoute une couche, utilisez ce fichier (3) :

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