Problème de copier coller en vba à partir d'excel

1 pièce(s) jointe(s)

Bonjour,

j'ai fait un petit bout de code en vba qui concatène les feuille Excel d'un répertoire en une seul, la copie se passe bien, et j'ai le bon résultat en ce qui concerne les données, par contre j'ai des apparitions bizarre du genre cellule en couleur (j'arrive pas à vous mettre de photo pour mieux expliciter le problème) sachant que je ne modifie la couleur des cellules nul part ailleurs dans mon programme.

Code:

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
 
' Consolider des données à partir de plusieurs feuilles
    Dim rep As String
    Dim wk As Workbook
    Dim ExisteFichier As Boolean
    Dim nomFic As String
    'Variable pour permettre de gerer les entetes
    Dim i As Integer
    i = 1
 
    'On Error GoTo Erreur_Fichier:
    Set XlBook = XlApp.Workbooks.Add
    Set XlSheet = XlBook.Worksheets(1)
 
 
 
    ' test de l'existence du fichier prestataire
     nomFic = ThisWorkbook.path & "\FichierPrestataireRes.xls"
     ExisteFichier = (Dir(nomFic) <> "")
     If ExisteFichier = True Then
        Kill nomFic
     End If
 
     XlBook.SaveAs ThisWorkbook.path & "\FichierPrestataireRes"
 
 
    Dim l As Long
    'Initialisations
    l = 5
    rep = ThisWorkbook.path & "\Prestataires\"
    s = Dir(rep)
 
 
    Do
        Set wk = CreateObject(rep & s)
    wk.Activate
 
    If i = 1 Then
    'recopier le masque du fichier
 
    Range("A3").Select
    Else
 
    'recopier les données à partir de la ligne 7 (modifier A7 par Ai si les données commencent à la ligne i)
    Range("A7").Select
    End If
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    XlBook.Activate
 
    If i = 1 Then
    l = XlSheet.Range("A65356").End(xlUp).Row
    Else
    l = XlSheet.Range("A65356").End(xlUp).Row + 1
    End If
 
    'formatage de largeur de cellule pour affichage optimal
 
    XlSheet.Range(XlSheet.Cells(1, 1), XlSheet.Cells(1, 2)).ColumnWidth = 20
 
    XlSheet.Range(XlSheet.Cells(1, 4), XlSheet.Cells(1, 5)).ColumnWidth = 36
 
    XlSheet.Range(XlSheet.Cells(1, 6), XlSheet.Cells(1, 7)).ColumnWidth = 22
 
    XlSheet.Range(XlSheet.Cells(1, 8), XlSheet.Cells(1, 9)).ColumnWidth = 15
 
    XlSheet.Range("A" & l).Select
    XlSheet.Paste
    wk.Activate
    Application.CutCopyMode = False
        wk.Close savechanges:=False
 
        s = Dir
        i = i + 1
    Loop While s <> ""
      XlBook.Save
    XlApp.Quit
 
    Range("A1").Select
    Selection.Copy
    Range("A2").Select
    ActiveSheet.Paste
 
 
 
'Erreur_Fichier:
    'MsgBox "Le Dossier Prestataire ne contient aucun fichier"
 
 
 
'Fermeture des classeurs sauf le classeur actif
'En enregistrant les modifications
 
For Each XlBook In Workbooks
    If XlBook.Name <> ThisWorkbook.Name Then
        XlBook.Close True
    End If
Next XlBook

Si quelqu'un a une idée d'ou sa viens!?
[IMG]D:\temp\res.jpeg[/IMG]

Bonjour,
Faire un collage des valeurs seulement en remplaçant
Code:

1 2 XlSheet.Paste
par
Code:

1 2 3 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False
L'apparition de couleurs est étrange. N'y a-t-il pas de Mise en forme conditionnelle ?

Merci pour ta réponse,
Ta solution ne marche pas pour moi si je fait exactement ce que tu m'as proposé je me retrouve avec un fichier en sortie qui est Vide.

Et en réponse à ta question il n'y a aucune mise en forme conditionnelle, et il y a pas de copier coller de cellule ou de mise en forme ailleurs dans mon code

En faisant du pas à pas, peux-tu vérifier le résultat du collage ?

Vu que je copie un bloc de chaque feuille je ne vois pas trop comment vérifier le collage en pas à pas (à part en regardant la feuille résultat à la fin de l’exécution). Tu peux être plus clair stp?