XL 2016 VB - Export plusieurs feuilles dans un seul ficher TXT

[enzo_s]

Bonjour à tous,

Je suis en train de réfléchir comment je pourrais faire un export de plusieurs feuilles dans un seul fichier txt.

Mon problème est que je ne sais pas comment prendre uniquement les lignes de la colonne A jusqu'au dernier text trouvé saut si c'est un ! et ceci des 3 feuilles.

Merci de l'aide

Enzo

 

[dg62]

Bonjour Enzo_s

jusqu'au dernier text trouvé saut si c'est un !

Davantage d’explications ne nuirait pas à la compréhension du problème. Le ! est t-il placé pour déterminer la dernière cellule valide ? est-ce qu'il y a des lignes vides, etc...

 

[enzo_s]

Salut Dg62,

Je joins un fichier c'est plus simple.

L’idée est qu’il exporte les feuilles en violets dans un seul ficher

1-RF-Profiles,
2-Aps_Grps
3-Flexconnect

Il doit prendre uniquement la colonne A de chaque feuilles jusqu'au dernier texte trouvé. Dans mon cas c'est ou il y a du texte ou c'est !

Exemple :

1-RF-Profiles ligne de 1 à 53
2-Aps_Grps ligne de 1 à 30
3-Flexconne ligne de 1 à 833

J’espère que c'est plus clair

 

[job75]

Bonjour enzo_s, dg62,

J’espère que c'est plus clair

Non.

 

[enzo_s]

Je ressaye avec des images.

Faire un export des 3 onglets violet dans 3 différents fichier TXT est facile. mais là la complexité et de le faire dans un seul fichier au final

 

[job75]

Ce qui n'est pas clair c'est l'histoire des "!", mais bon, d'après ce que je comprends exécutez cette macro :

Sub Fichier_texte()
Dim fichier As Variant, F As Worksheet, tablo, i&, txt$
ChDir ThisWorkbook.Path & "\" 'dossier affiché
fichier = "Fichier texte " & Format(Date, "yyyy-mm-dd")
fichier = Application.GetSaveAsFilename(fichier, "Text Files (*.txt), *.txt")
If fichier = False Then Exit Sub
For Each F In Sheets(Array("1-RF-Profiles", "2-Aps_Grps", "3-Flexconnect"))
    tablo = F.[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To UBound(tablo)
        If Not IsError(tablo(i, 1)) Then If tablo(i, 1) <> "!" Then txt = txt & vbCrLf & tablo(i, 1)
Next i, F
Open fichier For Output As #1
Print #1, Mid(txt, 2)
Close #1
End Sub

La boîte de dialogue "Enregistrer sous" permet de choisir le dossier d'enregistrement.

Fichier joint, j'ai allégé la feuille "2-Aps_Grps" en supprimant les lignes inutiles 181:1048576.

A+

 

[enzo_s]

Salut Job75,

C'est exactement ça !!

Je l'ai un peu modifié mais si je souhaite ajouter une condition du style " Si B39="Select" mettre un message d'erreur en indiquant de compléter

Option Explicit

Sub Export()
Dim fichier As Variant, F As Worksheet, tablo, i&, txt$
'prefixName = Range("").Value
ChDir ThisWorkbook.Path & "\" 'dossier affiché
'fichier = "Fichier texte" & prefixName & Format(Date, "yyyy-mm-dd")
fichier = "Fichier texte" & Format(Date, "yyyy-mm-dd")
fichier = Application.GetSaveAsFilename(fichier, "Text Files (*.txt), *.txt")
If fichier = False Then Exit Sub
Sheets("1-RF-Profiles").Visible = True
Sheets("1-RF-Profiles").Unprotect "*"
Sheets("2-Aps_Grps").Visible = True
Sheets("2-Aps_Grps").Unprotect "*"
Sheets("3-Flexconnect").Visible = True
Sheets("3-Flexconnect").Unprotect "*"
ActiveSheet.Unprotect "FTS"
For Each F In Sheets(Array("1-RF-Profiles", "2-Aps_Grps", "3-Flexconnect"))
    tablo = F.[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To UBound(tablo)
        If Not IsError(tablo(i, 1)) Then If tablo(i, 1) <> "!" Then txt = txt & vbCrLf & tablo(i, 1)
Next i, F
Open fichier For Output As #1
Print #1, Mid(txt, 2)
Sheets("1-RF-Profiles").Visible = False
Sheets("1-RF-Profiles").Protect "*"
Sheets("2-Aps_Grps").Visible = False
Sheets("2-Aps_Grps").Protect "*"
Sheets("3-Flexconnect").Visible = False
Sheets("3-Flexconnect").Protect "*"
Close #1
End Sub

 

[job75]

Si les 3 feuilles à copier sont protégées et masquées pas de problème, voyez le fichier joint.

Il suffit dans la macro de remplacer F.[A1].CurrentRegion par F.UsedRange :

Sub Fichier_texte()
Dim fichier As Variant, F As Worksheet, tablo, i&, txt$
ChDir ThisWorkbook.Path 'dossier affiché
fichier = "Fichier texte " & Format(Date, "yyyy-mm-dd")
fichier = Application.GetSaveAsFilename(fichier, "Text Files (*.txt), *.txt")
If fichier = False Then Exit Sub
For Each F In Sheets(Array("1-RF-Profiles", "2-Aps_Grps", "3-Flexconnect"))
    tablo = F.UsedRange.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To UBound(tablo)
        If Not IsError(tablo(i, 1)) Then If tablo(i, 1) <> "!" And tablo(i, 1) <> "" Then txt = txt & vbCrLf & tablo(i, 1)
Next i, F
Open fichier For Output As #1
Print #1, Mid(txt, 2)
Close #1
End Sub

Evidemment il ne faut pas que le UsedRange aille jusqu'à la ligne 1048576 comme le fichier du post #3 !!!

 

[enzo_s]

Oui parfait MErCI, j'ai corrigé je connaissais pas la différence entre les deux..

Encore une question, si je souhaite ajouter une condition du style " Si B39="Select" mettre un message d'erreur en indiquant de compléter la cellule.

Merci de l'aide

 

[job75]

If [B39] = "Select" Then MsgBox "coucou"

 

[enzo_s]

If [B39] = "Select" Then MsgBox "coucou"

re Salut Job75,

Merci pour ta réponse, j'ai ajouter la ligne mais j'arrive pas à sortir si la condition n'est pas remplie.

J'ai essayé de mettre un End if ou autre mais ça ne fonctionne pas. Il y a vraiment plein de chose à apprendre

Merci

Sub Export()
Dim prefixName As String
Dim fichier As Variant, F As Worksheet, tablo, i&, txt$
prefixName = Range("AQ6").Value
If [B39] = "Select" Then MsgBox "Please to select your WLC Name in the list"   
ChDir ThisWorkbook.Path & "\" 'dossier affiché
fichier = prefixName & " " & Format(Date, "yyyy-mm-dd")
fichier = Application.GetSaveAsFilename(fichier, "Text Files (*.txt), *.txt")
If fichier = False Then Exit Sub
ActiveSheet.Unprotect "**"
For Each F In Sheets(Array("1-RF-Profiles", "2-Aps_Grps", "3-Flexconnect"))
    tablo = F.UsedRange.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To UBound(tablo)
        If Not IsError(tablo(i, 1)) Then If tablo(i, 1) <> "!" Then txt = txt & vbCrLf & tablo(i, 1)
Next i, F
Open fichier For Output As #1
Print #1, Mid(txt, 2)
ActiveSheet.Protect "**"
Close #1
End Sub

 

[job75]

j'ai ajouter la ligne mais j'arrive pas à sortir si la condition n'est pas remplie.

If [B39] = "Select" Then MsgBox "Please to select your WLC Name in the list": Exit Sub