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
Je souhaitais garder les lignes de couleur dans le fichier de compilation
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
Savez vous le code que je dois ajouter ?
Merci d'avance
Partager