Copier .txt to worksheet et forcer format texte

Bonjour à tous,

après plusieurs heures d'essai, je me retrouve avec la macro suivante fonctionnelle :

Sub TxtMAJ()
    Dim path As String, feuilles As String, feuil, f As Long
    Dim wbExcel As Workbook, wbText As Workbook
    Dim wsExce1l As Worksheet
    Set wbExcel = ThisWorkbook 'specify here which Excel file the text file’s content is to be pasted into
    Set wsExcel1 = wbExcel.Sheets("blk") 'specify here which worksheet to use
    Set wbText1 = Workbooks.Open("C:\xxx\blk.txt")

    feuilles = "blk;bs"

    wbText1.Sheets("blk").Cells.Copy wsExcel1.Cells

    wbText1.Close SaveChanges:=False

    Sheets("blk").Select
    Rows("1:1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("blk").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("blk").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "K1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("blk").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("blk").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("blk").AutoFilter.Sort.SortFields.Add(Range("Q1"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
        255, 0)
    With ActiveWorkbook.Worksheets("blk").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter

    Columns("AA:AD").Select
    Selection.ClearContents

    Set wsExcel2 = wbExcel.Sheets("bs") 'specify here which worksheet to use
    Set wbText2 = Workbooks.Open("C:\xxx\bs.txt")

    wbText2.Sheets("bs").Cells.Copy wsExcel2.Cells

    wbText2.Close SaveChanges:=False

     Sheets("bs").Select
    Rows("1:1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("bs").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("bs").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "L1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("bs").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("bs").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("bs").AutoFilter.Sort.SortFields.Add(Range("Q1"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
        255, 0)
    With ActiveWorkbook.Worksheets("bs").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter

    Columns("AA:AD").Select
    Selection.ClearContents

    feuil = Split(feuilles, ";")
    Application.ScreenUpdating = False
    For f = 0 To UBound(feuil)
        Worksheets(feuil(f)).Copy
        With Worksheets(1)
            path = "C:\xxx\Imports Cargo\"
           Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:=path & LCase(feuil(f)) & ".txt", FileFormat:=xlText
            ActiveWorkbook.Close SaveChanges:=False
           Application.DisplayAlerts = True
        End With
    Next f

        Application.ScreenUpdating = False
    For f = 0 To UBound(feuil)
        Worksheets(feuil(f)).Copy
        With Worksheets(1)
            path = "C:\xxx\Imports WinExpe\"
           Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:=path & LCase(feuil(f)) & ".txt", FileFormat:=xlText
            ActiveWorkbook.Close SaveChanges:=False
           Application.DisplayAlerts = True
        End With
    Next f

End Sub

Le problème est le suivant : les fichier .txt (blk.txt et bs.txt) sont bien copiés vers mes feuilles excel du même nom puis triée mais le format "standard" est appliqué,

or, j'ai besoin de forcer le format de collage "texte" pour ne pas me retrouver avec des infos du type "4,22226E+13" mais bien "42222594792867".

Voila, je pense que c'est clair, merci pour votre aide car je sèche..!

Bonne fin de WE à tous,

Balek

bonjour,

For f = 0 To UBound(feuil)
Worksheets(feuil(f)).Copy
With Worksheets(1)
.Cells.NumberFormat = "#,##0" '<-----------------------------------------------
Path = "C:\xxx\Imports WinExpe\"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Path & LCase(feuil(f)) & ".txt", FileFormat:=xlText

Bonjour,

Merci mais non, je me retrouve avec des infos du style ""32,965,671,405,883"", il y a des " et des , en trop dans les .txt finaux...

Re,

c'est bon j'ai trouvé, il suffisait de transformer .Cells.NumberFormat = "#,##0" en .Cells.NumberFormat = "###0" en ça fonctionne parfaitement, merci !

Bonjour,

Finalement ça ne fonctionne pas parfaitement... en effet, si les premiers caractères d'une colonne sont des "0", ils sautent lors de la macro (cf. Fichier avant traitement et fichier après traitement).

Vous pouvez constater que le premier "0" de la 2eme colonne ainsi que le premier "0" de la colonne code postal ont disparus.

Quelqu'un à une idée de pourquoi ? et de comment régler le problème ?

Merci par avance,

Balek

Bonjour,

Up !

Merci par avance,

Balek