Bonjour tout le monde

Je rencontre un soucis au niveau collage spécial dans ma macro.
Je m 'explique, à mon travail, j ai besoin de générer des fiches xl automatiquement, le fichier
est créé rempli et ranger des un dossier (créé lui aussi s'il n'existe pas)
Mon pb est que la mise en forme n'est pas conservée ( ça reste du domaine de l'esthétisme )
mais je suis pointilleux ,lol.

Voici la macro que j'utilise, je l'ai mainte fois utilisé pour différents programme, j'ai pas encore fait le ménage,
excusez les quelques lignes superflus.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Private Sub CommandButton1_Click()
 
If Sheets("PROG").Range("B3").Value = "" Then
MsgBox ("Les cellules Client et NM doivent imperativement être renseignées !!")
GoTo finish
End If
If Sheets("PROG").Range("B5").Value = "" Then
MsgBox ("Les cellules Client et NM doivent imperativement être renseignées !!")
GoTo finish
End If
 
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim rng As Range
Dim tx As String
Dim sFichier As String
Dim sDossier0 As String
Dim sDossier_Client As String
Dim sFichier_NM As String
 
sDossier_Client = Sheets("PROG").Range("B5").Value
sFichier_NM = Sheets("PROG").Range("B3").Value
sDossier0 = ThisWorkbook.Path & "\" & sDossier_Client '& "\" & sDossier_Lct
sFichier = ThisWorkbook.Path & "\" & sDossier_Client & "\" & sFichier_NM
 
    Dim Rep As Integer
    Rep = MsgBox("Voulez-vous continuez ?", vbYesNo + vbQuestion, "Confirmation")
    If Rep = vbNo Then Exit Sub
    If Rep = vbYes Then
 
'Crée le dossier client s'il n'existe pas
If Dir(sDossier0, 16) = "" _
Then MkDir (sDossier0)
 
 
On Error GoTo finish
 'On créer l'objet Excel
 Set xlApp = CreateObject("Excel.Application")
 'On défini le nombre d'onglets (ici 5)
 xlApp.SheetsInNewWorkbook = 1
 'On ajoute un classeur
 Set xlBook = xlApp.Workbooks.Add
 'On donne un nom au classeur
 xlBook.SaveAs (ThisWorkbook.Path & "\" & sDossier_Client & "\" & sFichier_NM)  '& ".xls")
 'On copi l'onglet à sauvegarder
    Cells.Select
    Selection.Copy
    Range("E11").Select
'On rend le classeur visible
    xlApp.Visible = True
 
 'On créer l'objet onglet dans le nouveau classeur créé
 Set xlSheet = xlBook.Worksheets(1)
    xlSheet.Range("A1").Select
    xlSheet.Paste
    xlSheet.Range("E5").Select
    Application.CutCopyMode = False
 'On affecte un nom a l'onglet
    xlSheet.Name = "PROG"
    xlBook.Save
    xlBook.Close
    End If
finish:
End Sub
et ça c'est le bout de code que j'aimerai y incérer, qui marche tel quel, mais pas ds cette macro:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
Merci à celles et à ceux qui s'arrêteront afin d'essayer de m'aider

Bonne journée