Problème de copie sur nouveau classeur (contenu et format)

Bonjour,

Je souhaite créer un fichier qui va produire des factures sur un classeur indépendant à chaque client à partir d'un tableau donné.

J'ai réussi partiellement car les fichiers se créés et se sauvegardent dans le folder du fichier source.

Mon seul soucis est le suivant : les nouveaux classeurs ne conservent pas le format du fichier de départ

• il manque les cellules des colonnes B à D dans les nouveaux classeurs
• couleurs des cellules
• les colonnes E et F sont cachés
• absence de quadrillage en dehors du tableau

Une idée sur la solution ?

Le fichier est en pièce jointe.

Bonjour,

Je verrai plus le code de cette façon :

Sub Nouvellefacture()

    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Dico As Object
    Dim Cle As Variant
    Dim CelTrouve As Range
    Dim Adr As String
    Dim I As Integer

    With Worksheets("Facture"): Set Plage = Range(Cells(6, 1), Cells(Rows.Count, 4).End(xlUp)): End With

    Set Dico = CreateObject("Scripting.Dictionary")

    For Each Cel In Plage.Columns(1).Cells: Dico(Cel.Value) = "": Next Cel

    For Each Cle In Dico.Keys

        Set Fe = Sheets.Add

        Fe.Name = Cle

        Set CelTrouve = Plage.Find(Cle, , xlValues, xlWhole)

        I = 0

        If Not CelTrouve Is Nothing Then

            Adr = CelTrouve.Address

            Do

                I = I + 1: Fe.Cells(I, 1).Resize(, 4).Value = Range(CelTrouve, CelTrouve.Offset(, 3)).Value

                Set CelTrouve = Plage.FindNext(CelTrouve)

            Loop While CelTrouve.Address <> Adr

        End If

        Fe.Copy

        With ActiveWorkbook

            .SaveAs ThisWorkbook.Path & "\" & "Facture_" & Cle & ".xlsx"
            .Close

        End With

    Next Cle

    MsgBox "Travail terminé."

End Sub

Theze a écrit :

Bonjour,

Je verrai plus le code de cette façon :

Sub Nouvellefacture()

    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Dico As Object
    Dim Cle As Variant
    Dim CelTrouve As Range
    Dim Adr As String
    Dim I As Integer

    With Worksheets("Facture"): Set Plage = Range(Cells(6, 1), Cells(Rows.Count, 4).End(xlUp)): End With

    Set Dico = CreateObject("Scripting.Dictionary")

    For Each Cel In Plage.Columns(1).Cells: Dico(Cel.Value) = "": Next Cel

    For Each Cle In Dico.Keys

        Set Fe = Sheets.Add

        Fe.Name = Cle

        Set CelTrouve = Plage.Find(Cle, , xlValues, xlWhole)

        I = 0

        If Not CelTrouve Is Nothing Then

            Adr = CelTrouve.Address

            Do

                I = I + 1: Fe.Cells(I, 1).Resize(, 4).Value = Range(CelTrouve, CelTrouve.Offset(, 3)).Value

                Set CelTrouve = Plage.FindNext(CelTrouve)

            Loop While CelTrouve.Address <> Adr

        End If

        Fe.Copy

        With ActiveWorkbook

            .SaveAs ThisWorkbook.Path & "\" & "Facture_" & Cle & ".xlsx"
            .Close

        End With

    Next Cle

    MsgBox "Travail terminé."

End Sub

Bonjour,

Ce code est il adapté à son besoin !!!!

Je pense qu'il a besoin d'un bouton d'appel "Rechercher" qui fait apparaître des valeurs de recherche que sont "Date" ; "Serveur"; "Référence".

Cdt.

Ce code est il adapté à son besoin !!!!

A la vue de son code, campagniej veut copier les valeurs des différents clients dans une feuille qui leur est propre puis créer un nouveau classeur à partir de cette feuille pour chacun des clients et l'enregistrer dans le même dossier que le classeur source !

Je pense qu'il a besoin d'un bouton d'appel "Rechercher" qui fait apparaître des valeurs de recherche que sont "Date" ; "Serveur"; "Référence".

Heuuu, tu es sûr de répondre au bon post ? Qu'est ce que tu racontes avec tes "Date" ; "Serveur"; "Référence" ?

Je te rappelle les entêtes de colonnes de sa base de données : "Nom du client","Prenom du client", "Achat Vente" et "Prix".

Theze a écrit :

Ce code est il adapté à son besoin !!!!

A la vue de son code, campagniej veut copier les valeurs des différents clients dans une feuille qui leur est propre puis créer un nouveau classeur à partir de cette feuille pour chacun des clients et l'enregistrer dans le même dossier que le classeur source !

Je pense qu'il a besoin d'un bouton d'appel "Rechercher" qui fait apparaître des valeurs de recherche que sont "Date" ; "Serveur"; "Référence".

Heuuu, tu es sûr de répondre au bon post ? Qu'est ce que tu racontes avec tes "Date" ; "Serveur"; "Référence" ?

Je te rappelle les entêtes de colonnes de sa base de données : "Nom du client","Prenom du client", "Achat Vente" et "Prix".

Désolé je me suis gouré à la fin.