Bonjour,

J'ai un programme qui permet de copier des lignes de fichiers excel et de les compiler sur un seul comme l'indique le code ci dessous

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
Sub Transfert_des_lignes()
'
'Sub tranfertClasseursFermes_VersFeuilleActive()
    'Nécessite d'activer la référence
        'Microsoft ActiveX Data Objects x.x Library
    Dim cn As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim j As Integer
    Dim i As Long
    Dim Fichier As String, Repertoire As String, Name As String
    Name = "Feuil1"
 
 
    i = 1
 
    'Boucle sur les classeurs Excel du répertoire cible
    Repertoire = "D:\DATAN\Test_Excel\Essai_2"
    Fichier = Dir(Repertoire & "\*.xls")
 
    Do While Fichier <> ""
        'Connection au classeur Excel
        Set cn = New ADODB.Connection
        cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & Repertoire & "\" & Fichier & ";" & _
            "Extended Properties=""Excel 8.0;"""
 
        'requête pour extraire les données de la Feuil1
        Set Rst = New ADODB.Recordset
 
        Rst.Open "SELECT * from [Feuil1$]", cn, adOpenStatic
 
        'Si la requete donne un resultat
        If Not Rst.EOF Then
            'S'il s'agit de la premiere ligne :
            'on boucle sur les en-tetes afin d'en extraire les noms
            If i = 1 Then
                For j = 0 To Rst.Fields.Count - 1
                    Cells(i, j + 1) = Rst.Fields(j).Name
                Next j
 
                i = 2
            End If
 
            'Copie le résultat de la requete dans la feuille active
            Range("A" & i).CopyFromRecordset Rst
            'Récupère le numero de la premiere ligne vide pour la
            'boucle suivante.
            i = Range("A1").End(xlDown).Row + 1
        End If
 
        'Fermeture recordset
        Rst.Close
        Set Rst = Nothing
        'Fermeture de la connection au classeur Excel
        cn.Close
        Set cn = Nothing
    Fichier = Dir
    Loop
 
End Sub
Je souhaitais garder les lignes de couleur dans le fichier de compilation

Savez vous le code que je dois ajouter ?

Merci d'avance