Rechercher plusieurs valeurs

Elles apparaissent sous quel format ? Sinon vous pouvez utiliser l'option enregistrement de macro pour mettre la colonne au format qui vous intéresse (vous devriez trouver une formule de ce genre : Columns("D:D").Select

Selection.NumberFormat = "h:mm:ss" ), Excel fournit le code des différentes actions pendant l'enregistrement (le code n'est pas optimisé mais ça donne un gros coup de pouce quand on ne sait pas comment écrire ce que l'on veut faire)

Elles apparaissent en "standard".

Pourtant avec la macro de Link les fichiers générés cette colonne apparait en heure, ou ce trouve cette ligne dans sa macro?

Re à tous,

J'ai rajouté un bloc pour la mise en forme de chaque tableau généré.

Pour la somme pas besoin de boucler

Sub Creation_classeurs3()
Dim rng As Range, i As Long, e, wb As Workbook
    Application.ScreenUpdating = False
    Set rng = Sheets("Feuil1").Range("a4").CurrentRegion
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To rng.Rows.Count
            If Not .exists(rng.Cells(i, 6).Value) Then
                Set .Item(rng.Cells(i, 6).Value) = _
                Union(rng.Rows(1), rng.Rows(i))
            Else
                Set .Item(rng.Cells(i, 6).Value) = _
                Union(.Item(rng.Cells(i, 6).Value), rng.Rows(i))
            End If
        Next
        For Each e In .keys
            Set wb = Workbooks.Add
            .Item(e).Copy wb.Sheets(1).Cells(1)
            ''''''
            'Mise en forme du tableau généré
            With wb.Sheets(1).Cells(1).CurrentRegion
                With .Rows(1)
                    .Interior.ColorIndex = 44
                    .BorderAround Weight:=xlThin
                End With
                With .Rows(.Rows.Count + 1)
                    .Cells(1) = "Total facturé"
                    .Cells(5).Formula = "=sum(r2c:r[-1]c)"
                    .Interior.ColorIndex = 19
                    .BorderAround Weight:=xlThin
                End With
                'Formate la colonne 4 au format durée
                With .Columns(4).Offset(1).Resize(.Rows.Count - 1)
                    .NumberFormat = "[hh]:mm:ss"
                End With
                With .Resize(.Rows.Count + 1)
                    .Font.Name = "calibri"
                    .Font.Size = "10"
                    .VerticalAlignment = xlCenter
                    .Borders(xlInsideVertical).Weight = xlThin
                    .BorderAround Weight:=xlThin
                End With
                .Columns.AutoFit
                .Rows.RowHeight = 18
            End With
            ''''''
            On Error Resume Next
            wb.SaveAs ThisWorkbook.Path & "\" & Replace(e, "/", "-") & ".xls"
            wb.Close False: Set wb = Nothing
            Err.Clear
        Next
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

klin89

Re berty42

Suite à ton message privé, le code réajusté.

Ici, on prend en compte les 4 lignes d'en-tête que l'on copie dans chaque fichier généré,

les autres données sont traitées à partir de la ligne 5.

Attention, ne pas laisser de lignes vides dans ton tableau source, j'emploie la méthode CurrentRegion

Le tableau source figure dans la 1ère feuille de ton classeur soit Sheets(1)

Sub Creation_classeurs3()
Dim rng As Range, i As Long, e, wb As Workbook
    Application.ScreenUpdating = False
    Set rng = Sheets(1).Range("a1").CurrentRegion
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 5 To rng.Rows.Count
            If Not .exists(rng.Cells(i, 6).Value) Then
                Set .Item(rng.Cells(i, 6).Value) = _
                Union(rng.Rows(1), rng.Rows(2), rng.Rows(3), rng.Rows(4), rng.Rows(i))
            Else
                Set .Item(rng.Cells(i, 6).Value) = _
                Union(.Item(rng.Cells(i, 6).Value), rng.Rows(i))
            End If
        Next
        For Each e In .keys
            Set wb = Workbooks.Add
            .Item(e).Copy wb.Sheets(1).Cells(1)
            'Mise en forme du tableau généré
            With wb.Sheets(1).Cells(1).CurrentRegion
                With .Rows(.Rows.Count + 2)
                    With .Cells(5)
                        '.Formula = "=sum(r2c:r[-1]c)"
                        .Formula = "=sum(r5c:r[-2]c)"
                        .Interior.ColorIndex = 19
                        .BorderAround Weight:=xlThin
                    End With
                End With
                'Formate la colonne 4 au format durée
                With .Columns(4).Offset(4).Resize(.Rows.Count - 4)
                    .NumberFormat = "[hh]:mm:ss"
                End With
                With .Resize(.Rows.Count + 2)
                    .Font.Name = "calibri"
                    .Font.Size = 11
                    .VerticalAlignment = xlCenter
                    .Columns.AutoFit
                    .Columns(1).ColumnWidth = 30
                    .Rows.RowHeight = 18
                End With
            End With
            ''''''
            On Error Resume Next
            'ici ne pas dépasser le nombre limite de caracteres
            wb.SaveAs ThisWorkbook.Path & "\" & Replace(e, "/", "-") & ".xls"
            wb.Close False: Set wb = Nothing
            Err.Clear
        Next
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Bonne nuit klin89

Bonjour à tous,

Je voulais vous remercier pour votre aide, tout fonctionne correctement, je gagne un temps fou!!!

Merci!!