XL 2019 Macro : Colonnes excel vers Bloc Note

[Bastien43]

Bonjour,

Je recherche une macro, qui lorsque je clique sur le bouton, me permettrait d'extraire la colonne de coefficients (B) vers un bloc note dont l'en tête existe déjà. Et mettre à jour le bloc note; en écrasant les données précédentes si il y en a et en sauvegardant. Ceci afin de ne pas le faire moi même avec des copier / Coller.
Est-ce possible ?

Je vous remercie pour votre aide
Cordialement
Bastien

 

[Lolote83]

Bonjour BASTIEN43,
Peut être avec ce code

Sub SauvegarderTexte()
    On Error GoTo Erreur
    
    Dim F As Integer
    Dim MonTexte As String
    Dim MonFichier As String
    
    F = FreeFile
    MonFichier = "C:\Users\Toto\Documents\Secteur.txt"      'Chemin et nom du fichier a adapter
    Application.ScreenUpdating = False

    xDerLig = Range("B65000").End(xlUp).Row
    '------------------------------------
    '                          Sauvegarde
    '------------------------------------
    Open MonFichier For Output As #F
        Print #F, "EPANET Pattern Data"
        Print #F, "Courbe de modulation de SECTEUR"
        For Each xCell In Range("B3:B" & xDerLig)
            Print #F, Format(xCell.Value, "0.00")
        Next xCell
    Close #F
    
    Application.ScreenUpdating = True
    MsgBox "Le texte a été sauvegardé dans: " & MonFichier
    Exit Sub
Erreur:
    MsgBox "Une erreur est survenue..."
End Sub

@+ Lolote83

 

[Bastien43]

Bonjour,

Merci beaucoup c'est top ca marche.

Autre question svp : est-il possible de faire la même chose pour plusieurs feuilles excel ? C'est-à-dire 1 seul bouton pour extraire plusieurs fichiers textes correspondants à chaque feuille du classeur ? Les cellules de chaque feuille sont de format identiques.

Je vous remercie
Bastien

 

[Lolote83]

Re bonjour,
Oui certainement, mais a mon tout de poser une question.
Les données des différents onglets seront-ils regroupés sur un seul et même fichier TXT ou chaque onglet aura son propre fichier TXT ?
Merci de me dire
@+ Lolote83

 

[job75]

Bonjour Bastien43, Lolote83,

Les données des différents onglets seront-ils regroupés sur un seul et même fichier TXT ou chaque onglet aura son propre fichier TXT ?

C'est-à-dire 1 seul bouton pour extraire plusieurs fichiers textes correspondants à chaque feuille du classeur ?

C'est bien clair.

A+

 

[job75]

L'écriture séquentielle présentée par Lolote83 est certainement la méthode la plus rapide.

Mais celle-ci est très classique et très rapide aussi :

Sub MAJ_Fichiers_textes()
Dim chemin$, w As Worksheet
chemin = ThisWorkbook.Path & "\" 'dossier à adapter si nécessaire
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si l'un des fichiers a déjà été créé
With Workbooks.Add.Sheets(1) 'document auxiliaire
    For Each w In ThisWorkbook.Worksheets
        w.Columns(2).Copy .Cells(1)
        .Cells(1) = "EPANET Pattern Data"
        .Cells(2, 1) = "Courbe de modulation de " & w.Name
        .Parent.SaveAs chemin & w.Name & ".txt", xlText 'enregistre sous
        .Columns(1).Clear 'RAZ
    Next
    .Parent.Close False 'ferme le document auxiliaire
End With
End Sub

 

[Bastien43]

Bonjour,

Super ca marche aussi. Merci beaucoup. oui il s'agissait bien d'un fichier texte par feuille.

Cordialement
Bastien

 

[Bastien43]

Merci à tous pour votre aide

 

[job75]

Par curiosité j'ai testé avec 1000 feuilles identiques SECTEUR 1 SECTEUR 2... SECTEUR 1000.

Macro du post #6 => 30 secondes, ce n'est pas trop mal...

Macro du post #2 (adaptée avec une boucle) => 0,8 seconde, y a pas photo !!!

 

[Bastien43]

Pourriez-vous l'écrire avec la boucle et le partager svp ?

 

[job75]

C'est à Lolote83 de le faire mais bon :

Sub SauvegarderTexte()
    Dim chemin$, w As Worksheet, F%, MonFichier$, xDerlig&, xcell As Range
    chemin = ThisWorkbook.Path & "\" 'dossier à adapter
    For Each w In Worksheets
        F = FreeFile
        MonFichier = chemin & w.Name & ".txt"
        xDerlig = w.Range("B" & w.Rows.Count).End(xlUp).Row
        Open MonFichier For Output As #F
        Print #F, "EPANET Pattern Data"
        Print #F, "Courbe de modulation de " & w.Name
        For Each xcell In w.Range("B3:B" & xDerlig)
            Print #F, Format(xcell.Value, "0.00")
        Next xcell
        Close #F
    Next w
End Sub

 

[Bastien43]

Merci beaucoup pour votre aide
Bonne soirée

 

[Lolote83]

Bonjour à tous,
Merci à Job75 (que je salue au passage) d'être passé par là et d'avoir complété la demande de Bastien43.
Mes obligations paternelles rendent difficile pour moi des réponses le soir. Donc merci encore à Job75.
Cordialement
@+ Lolote83

 

[Bastien43]

Bonjour
Merci beaucoup cela m a beaucoup aidé.
Cordialement