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 Impliqué
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!
 
Dernière édition:

Leché

XLDnaute Junior
1611669337402.png


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

XLDnaute Barbatruc
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
 
Dernière édition:

dysorthographie

XLDnaute Impliqué
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
 

Leché

XLDnaute Junior
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é

XLDnaute Junior
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

XLDnaute Barbatruc
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
 

patricktoulon

XLDnaute Barbatruc
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 🤣 🤣 🤣 🤣
 

Discussions similaires

Réponses
11
Affichages
758
Haut Bas