Bonjour à tous,

Le but de mon programme est de faire un résumé avec certaines ligne provenant d'autres fichiers excels (ayant pour nom : Übersicht_******.xls, ****** étant la date). Les fichiers sont placé dans un dossier specifique. Le programme fait en premier le listing des fichiers excels presents dans ce dossier, puis determine le nombre de ligne à recopier dans l'excel final.
Les fichier de base ont une premiere colonne de ce type:

1.1
1.2
1

2.1
2.2
2

3.1
...


Mon objectif est de récuperer uniquement les lignes 1,2,3,... Pour ce faire, j'applique à la première colonne une formule me permettant de retourner le plus grand entier, ce qui me renseigne sur le nombre de ligne a copier. J'inscrit cette valeur dans le premier onglet de l'excel final.

Ensuite un autre sous programme (Sub copie) récupère cette valeur (nombre de ligne) que j'appelle cas, en fonction de la valeur de cas, il y a un nombre d'itération définit.

Problèmes:

1)Mon problème principal est que je n'arrive pas a faire fonctionner une boucle for permettant d'appliquer la formule à chaque excel presents. c'est a dire integrer une variable dans le chemin lui même dans uns formule.

2) Comment faire pour rendre la variable "lign" globale ( utilisable par tous les Sub) ?

3) Je voudrais transfomer ce chemin en chemin relatif pour que mes collègues puissent utiliser ce programmes sur leur oridinateur.

4) Je pense supprimer le "Select Case cas" dans Sub copie pour uniquement inserer la variable cas, cette méthode me permettait de controler facilement par un affichage


le code:
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
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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
 
Sub FINAL()
'
' Tabelle1 Makro
' Makro am 15.09.2010 von cc14 aufgezeichnet
'
 
'
Application.ScreenUpdating = False
 
Excels_presents_dans_le_dossier
 
copie
 
mise_en_page
 
Application.ScreenUpdating = True
 
End Sub
 
Sub Excels_presents_dans_le_dossier()
'
' Excels_presents_dans_le_dossier Makro
' Makro am 15.09.2010 von cc14 aufgezeichnet
'
 
'
    chemin = "D:\cc14\Test bed\Test 7\Automatisation\Übersicht"
    lign = 2
    fich = Dir(chemin & "\*.xl*")
    plus_grand_entier = "=MAX(INT([Übersicht_100820.xls]Übersicht!R5C1:R62C1))"
 
    [C1] = "Colonne de test"
 
 
étiq:
    ThisWorkbook.Sheets("Tabelle1").Cells(lign, 1) = fich
    Workbooks.Open chemin & "\" & fich
 
    ThisWorkbook.Sheets("Tabelle1").Cells(lign, 2).FormulaR1C1 = "=INT(MAX([Übersicht_100820.xls]Übersicht!R5C1:R62C1))"
 
    ActiveWorkbook.Close
    fich = Dir
        If fich <> "" Then
        lign = lign + 1
        GoTo étiq
        End If
 
    ThisWorkbook.Sheets("Tabelle1").Cells(1, 1) = "Excels présents"
    ThisWorkbook.Sheets("Tabelle1").Cells(1, 2) = "Nombre de valeurs"
    Cells(lign + 2, 1) = "Nombre de fichiers : " & lign - 1
 
    Cells(lign + 2, 2).Select
    ActiveCell = "=SUM(B2:B" & ActiveCell.Offset(-2, 0).Row & ")"
 
'
'
MsgBox "Il y a " & lign - 1 & " Excel(s) dans le fichier"
 
ThisWorkbook.Sheets("Tabelle1").Cells(50, 50) = lign ' ____________A EFFACER PLUTARD !!!!!!_____________
 
 
End Sub
 
Sub mise_en_page()
'
' mise_en_page Makro
' Makro am 15.09.2010 von cc14 aufgezeichnet
'
 
'
    Columns("A:D").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Cells(13, 5).Select
    Columns.EntireColumn.AutoFit
End Sub
 
Sub copie()
'
' copie Makro
' Makro am 20.09.2010 von cc14 aufgezeichnet
'
 
'
n = 0 'Initialisation du numéro de ligne pour le tableau d'arrivé
ThisWorkbook.Sheets("Tabelle1").Cells(2, 3) = "avant boucle"
lign = ThisWorkbook.Sheets("Tabelle1").Cells(50, 50)
ThisWorkbook.Sheets("Tabelle1").Cells(1, 4) = "test Cas"
 
For i = 2 To lign
    cas = ThisWorkbook.Sheets("Tabelle1").Cells(i, 2)
    ThisWorkbook.Sheets("Tabelle1").Cells(3, 3) = "dans For" 'Controle du For
    Select Case cas
        Case 1
            l = 3 'Initialisation du numéro de ligne pour chaque tableau source
 
            For f = 1 To cas
                l = l + 4 '4 incrémentations de la ligne pour le tableau source
                n = n + 1 'incrémentation de la ligne du tableau d'arrivé
                ThisWorkbook.Sheets("Tabelle2").Cells(n, 1) = "1"
                ThisWorkbook.Sheets("Tabelle1").Cells(i, 4) = "Cas 1" 'Controle du Cas 1
            Next
'_______
        Case 2
            l = 3 'Initialisation du numéro de ligne pour chaque tableau source
 
            For f = 1 To cas
                l = l + 4 '4 incrémentations de la ligne pour le tableau source
                n = n + 1 'incrémentation de la ligne du tableau d'arrivé
                ThisWorkbook.Sheets("Tabelle2").Cells(n, 1) = "2"
                ThisWorkbook.Sheets("Tabelle1").Cells(i, 4) = "Cas 2" 'Controle du Cas 2
            Next
'_______
        Case 3
            l = 3 'Initialisation du numéro de ligne pour chaque tableau source
 
            For f = 1 To cas
                l = l + 4 '4 incrémentations de la ligne pour le tableau source
                n = n + 1 'incrémentation de la ligne du tableau d'arrivé
                ThisWorkbook.Sheets("Tabelle2").Cells(n, 1) = "3"
                ThisWorkbook.Sheets("Tabelle1").Cells(i, 4) = "Cas 3" 'Controle du Cas 3
            Next
 
 
    End Select
 
Next
 
End Sub
Merci

PS: C'est mon premier code vba