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

soflab Messages postés 1 Date d'inscription   Statut Membre Dernière intervention   -  
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   -
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
A voir également:

1 réponse

Réponse 1 / 1
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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
0
Soflab
 
Merci beaucoup pour votre réponse . Par contre les largeurs de colonne ne sont pas les mêmes (trop petites ) sur les fichiers crées ..
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > Soflab
 
Re, 

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]
                'largeurs colonnes fonction contenu
                nwbk.Sheets(1).Cells.EntireColumn.AutoFit
                nwbk.SaveAs chemin & .Cells(1, i)
                nwbk.Close True
            End If
            Set nwbk = Nothing
        Next i
    End With
End Sub
0
Soflab
 
13 fichiers se sont créés (au lieu des 200 attendus )un message d erreur est apparu :
erreur d exécution 1004 fichier inaccessible. A quoi cela peut être du? Merci encore
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > Soflab
 
Re,


200 fichiers a creer,faudrait mettre une attente entre deux creations de fichier

voir ceci

https://docs.microsoft.com/fr-fr/office/vba/api/excel.application.wait?redirectedfrom=MSDN
0

Discussions similaires

taxe foncière pour locataire
Cryséis -
irongege -

1 réponse