Programme Génération de fichiers - problème de format de cellule

Question

Bonjour, 
Je débute en programmation et sollicite votre aide car le programme que j'utilise génère bien les fichiers souhaités automatiquement mais le format des cellules n'est pas le même que le fichier d'origine... un grand merci pour votre aide!
voici le programme

Sub a()
  Dim i As Long, nwbk As Workbook, chemin$
chemin = "C:\Temp\"
Application.ScreenUpdating = False
For i = 2 To Columns.Count
With ThisWorkbook.ActiveSheet
    If .Cells(1, i) <> "" Then
    Set nwbk = Workbooks.Add(-4167)
        .Range("A2:A114").Copy nwbk.Sheets(1).[A1]
        .Cells(1, i).Resize(.Cells(.Rows.Count, i).End(xlUp).Row).Copy nwbk.Sheets(1).[B1]
         nwbk.SaveAs chemin & .Cells(1, i)
         nwbk.Close True
    End If
End With
Set nwbk = Nothing
Next i
End Sub

f894009 · Answer

Bonjour,

pas de probleme de format cellule !!!!

par contre 
columns.count=16384 si excel2007 et plus ou 255 excel 97-2003

j'ai mis derniere colonne utilisee ligne 1

Sub a()
    Dim i As Long, nwbk As Workbook, chemin$
    chemin = "d:\_atest\"
    Application.ScreenUpdating = False
    With ThisWorkbook.ActiveSheet
        'dernier colonne utilisee ligne 1
        derco = Cells(1, Columns.Count).End(xlToLeft).Column
        For i = 2 To derco
            If .Cells(1, i) <> "" Then
                Set nwbk = Workbooks.Add(-4167)
                .Range("A1:A20").Copy nwbk.Sheets(1).[A1]
                .Cells(1, i).Resize(.Cells(.Rows.Count, i).End(xlUp).Row).Copy nwbk.Sheets(1).[B1]
                nwbk.SaveAs chemin & .Cells(1, i)
                nwbk.Close True
            End If
            Set nwbk = Nothing
        Next i
    End With
End Sub

Programme Génération de fichiers - problème de format de cellule

1 réponse

Votre réponse

Discussions similaires

Newsletters