Discussion :

[grimgrim]

bonjour,

Le code joint permet de copier toutes les lignes Xls des fichiers dans un répertoire et les regrouper dans un seul.

Sauf que ce code ne permet pas de récupérer les couleurs de chaque ligne.

Avez vous une idée de ce que je peux ajouter au code pour réaliser cette fonction ?
Merci d'avance

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_1"
    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

[Pelote2012]

Voici un code que j'utilise pour copier d'une feuille sur une autre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Sheets(types).Range("A1:C3").Copy Destination:=Sheets(types).Range("A8")

Tu peux adapter car quand tu ouvres plusieurs classeur tu y accède par une syntaxe du genre:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

workbook("Classeur1").sheets("NomSheet")...

[grimgrim]

bonjour,

merci pour cette réponse rapide.

Par contre, je ne suis pas fort dans ce type de code. Peux tu me dire si je dois remplacer mon code par le code que tu proposes ou sinon peux tu traduire ton code dans le code que je proposes ?

cordialement,