XL 2013 Macro export vers .txt

Leché · 25 Janvier 2021

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

dysorthographie · 26 Janvier 2021

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

danielco · 26 Janvier 2021

Leché à dit:
Cela me génère une erreur

Regarde la pièce jointe 1093031

Oups, désolé :

VB:

If C <> "" And C.EntireRow.Hidden = False Then

Leché · 26 Janvier 2021

ChTi160 à dit:
Re
Peut être avec un truc du genre

VB:

.Rows(C.Row).Hidden=False

non testé
jean marie

Que j'ajoute a quel niveau du code ?

Leché · 26 Janvier 2021

danielco à dit:
Oups, désolé :

VB:

If C <> "" And C.EntireRow.Hidden = False Then

Super , sa marche , maintenant j'essai de dupliquer le code pour faire sur 2 onglets et créer 2 fichier txt

ChTi160 · 26 Janvier 2021

Re
Lol
le Hidden , il était ou ?
mais bon ! si ca fonctionne #48
jean marie

dysorthographie · 26 Janvier 2021

il faut factoriser ton code dans une sub pour les 2 onglets et pas le recopier!

VB:

Private Sub test()
FichierTxt Sheets("X"), "C:\Test\x.txt"
FichierTxt Sheets("Y"), "C:\Test\y.txt"
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 #1
End Sub

en cas de modification tu n'as qu'un endroit à modifier!

Leché · 26 Janvier 2021

J'ai rajouté le code surligné en jaune + accolade, l'erreur que j'ai pour le moment est celle en parenthèse rouge : je ne vois pas pourquoi cela ne fonctionne pas, je pensais séparer distinctement les deux codes pour les onglets

ChTi160 · 26 Janvier 2021

Re
Tu mets de belles Images super !
On peut même pas récupérer le Code y'faudrait donc tout refaire Lol
Prend plutôt ce qui est au #50
ce sera plus simple pour toi !
il te manque un FichierNum=FreeFile pour la deuxième opération sur la feuille "30x2"
tu as aussi Wkb.Close dans la première partie donc ca peut pas marcher pour la feuille 30x2 car fichier fermé Lol
Il faudrait peut être le mettre en fin de Procédure !
Bonne Continuation
jean marie

dysorthographie · 26 Janvier 2021

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

patricktoulon · 26 Janvier 2021

re

quatre page pour copier en text les valeurs d'une colonne de ligne 7 à x
ah bravo!!!
ok je sort

Leché · 26 Janvier 2021

dysorthographie à dit:

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, 6).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

Je teste ça de suite , j'était entrain d'essayer d'adapter avec toutes les versions que vous avez mise, je n'avais pas vu que tu avais mis le code tout propre a la fin

Leché · 26 Janvier 2021

patricktoulon à dit:
re

quatre page pour copier en text les valeurs d'une colonne de ligne 7 à x
ah bravo!!!
ok je sort

Chacun a donné son point de vue, ce fut un sujet riche en débat et en solutions diverses

Leché · 26 Janvier 2021

ChTi160 à dit:
Re
Tu mets de belles Images super !
On peut même pas récupérer le Code y'faudrait donc tout refaire Lol
Prend plutôt ce qui est au #50
ce sera plus simple pour toi !
il te manque un FichierNum=FreeFile pour la deuxième opération sur la feuille "30x2"
tu as aussi Wkb.Close dans la première partie donc ca peut pas marcher pour la feuille 30x2 car fichier fermé Lol
Il faudrait peut être le mettre en fin de Procédure !
Bonne Continuation
jean marie

Merci

ChTi160 · 26 Janvier 2021

Re
pour dysorthographie
A quel moment ouvres tu le Fichier "FDS" , car si je lance cette procédure #50 j'ai une erreur les feuilles Sheets("X") et Sheets("Y") n'existent pas normal je n'ai pas ouvert le fichier source Lol
Ok j'avais pas vu #53
Bonjour à Patrick ! Toujours aussi pressé Lol
jean marie

dysorthographie · 26 Janvier 2021

en #50 je voulais montrer comment factorise le code désolé!

regarde la version complète #53

patricktoulon · 26 Janvier 2021

Chacun a donné son point de vue, ce fut un sujet riche en débat et en solutions diverses

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

XL 2013 Macro export vers .txt

Leché

XLDnaute Junior

dysorthographie

danielco

XLDnaute Accro

Leché

XLDnaute Junior

Leché

XLDnaute Junior

ChTi160

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

Leché

XLDnaute Junior

ChTi160

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

Leché

XLDnaute Junior

Leché

XLDnaute Junior

Leché

XLDnaute Junior

ChTi160

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

Discussions similaires