Discussion :

[sergio_gr66]

Bonjour et merci a tous pour votre attention.

J'ai un probléme avec un compter dans une macro Excel, je vous di quelle et le code:

Code :

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

1
2
3
4
5
6
7
 
range("A1").select
activecell.formulaR1C1 = "1"
range("A2").select
activecell.formulaR1C1 = "2"
range("A1:A2").select
Selection.Autofill destination:=range(selection,selection.end(xlDown))

j'ai besoin de faire un compter dans la colonne "A" de mon fichier Excel

merci a tous

[casefayere]

Bonjour,
je n'ai peut-etre pas compris, mais essayes ce code

Code :

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

1
2
3
4
5
With Sheets("feuil2")'nom de ta feuille
.Range("A1").Value = "1"
.Range("A2").Value = "2"
.Range("a" & .Range("a" & .Rows.Count).End(xlUp).Row + 1) = Application.WorksheetFunction.Sum(.Range("A1:A2"))
End With

[Krovax]

J'ai pas vraiment compris ta question
Mais essaye ceci

Code :

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

1
2
3
4
5
6
dim i as integer, derniereligne as integer
derniereligne=25 'remplace 25 par ta dernière ligne du compteur
 
for i = 1 to derniereligne
   cells(i,1)=i
next i

Edit : Bonjour casefayere, on s'est croisé mais visiblement on a pas du tout compris la même chose Au moins on double nos chance de répondre juste

[Access Newbie]

bonjour,

Code :

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

1
2
 
MsgBox Application.WorksheetFunction.Count(ThisWorkbook.Sheets("Feuil1").Range("A1:A65536"))

En supposant que la feuille sur laquelle vous voulez compter s'appelle "Feuil1".

Bonne journée.

[sergio_gr66]

je suis desolée, parce que je ne parle bien le française

Je vous explique, tout la macro, ouvre quellque fichier excel et apres coupie et colle les données dedans le fichier ou c'est trouve la macro, mais les donées ne sont pas une quantité constant, c'est pour sa que j'ai besoin savoir combien lignes sont collé.

[Access Newbie]

Et nos solutions, vous les avez testées ?

[Krovax]

Code :

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

1
2
3
 DerniereLigne = Range("A65536").End(xlUp).Row
ou
NbLignes = ActiveSheet.UsedRange.Rows.Count

Le premier te donne le numéro de la dernière ligne
le deuxième le nombre de ligne (sans compter les lignes vides)

Cela devrais correspondre a ton besoin

[sergio_gr66]

Et nos solutions, vous les avez testées ?

Pas encore, j'ai beaucoup de travail, mais cetainement je vais faire, merci beaucoup, quand je les ai tertées je vous diré

[sergio_gr66]

Code :

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

1
2
3
 DerniereLigne = Range("A65536").End(xlUp).Row
ou
NbLignes = ActiveSheet.UsedRange.Rows.Count

Le premier te donne le numéro de la dernière ligne
le deuxième le nombre de ligne (sans compter les lignes vides)

Cela devrais correspondre a ton besoin

Bonjour je veux savoir por quio range("A65536"),,
Merci

[garion28]

65536 est la dernière ligne d'une feuille excel

ce que j'ai peut etre compris: tu voudrai importer les données d'autres fichier excel vers le fichier où tu écrit ta macro ?

[casefayere]

Code :

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

DerniereLigne = Range("A65536").End(xlUp).Row

ou

Code :

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

range("a" & rows.count).end(xlup).row

donne la derniere cellule occupée dans la colonne "A"

alors

Code :

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

DerniereLigne = Range("A65536").End(xlUp).Row + 1

ou

Code :

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

range("a" & rows.count).end(xlup).row + 1

donne la première cellule vide mais il faut déclarer la variable

Code :

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

1
2
dim derniereligne as integer
DerniereLigne = Range("A65536").End(xlUp).Row + 1

ou

Code :

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

1
2
dim derniereligne as integer
range("a" & rows.count).end(xlup).row + 1

[garion28]

a quoi ca sert de déclarer une variable si celle ci n'est pas utilisé dans le code ?

[casefayere]

pas grave il suffit de rectifier, code vite fait

Code :

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

1
2
dim derniereligne as integer
derniereligne=range("a" & rows.count).end(xlup).row + 1

[sergio_gr66]

65536 est la dernière ligne d'une feuille excel

ce que j'ai peut etre compris: tu voudrai importer les données d'autres fichier excel vers le fichier où tu écrit ta macro ?

Oui c'est sa, le probleme c'est que j'ai besoin importer les données de, peut etre 200 fichiers, et le probleme est que chaque fichier a different quantite de donnees, puor sa j'ai besoin faire un compter puor sovoir ou coller le données prochains sans eliminer les donnees que son maintenant dans mon base de donées, je vous montre tous la macro:

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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
Sub CHERCHER()
 
'elimina los datos de la busqueda anterior
Sheets("feuil1").Select
Cells.Select
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
Sheets("CP").Select
Cells.Select
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
Sheets("EM").Select
Cells.Select
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
Sheets("feuil1").Select
Sheets("CP ou EM").Select
Cells.Select
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
Sheets("feuil1").Select
 
 
 
'Elimina la configuracion de las fuentes
Cells.Select
Selection.Font.Bold = True
Selection.Font.Bold = False
 
 
 
With Application.FileSearch
    .NewSearch
    .LookIn = "F:\DESSINS"
    .SearchSubFolders = False
    .Filename = "*.XLS"
    .FileType = msoFileTypeAllFiles
    If .Execute() > 0 Then
        MsgBox "Il y a " & .FoundFiles.Count & _
        " fichiers(s) trouves."
        For i = 1 To .FoundFiles.Count
            Range("a" & i).Select
            ActiveCell.FormulaR1C1 = .FoundFiles(i)
            Range("b" & i).Select
            ActiveCell.FormulaR1C1 = "=HYPERLINK(RC[-1],""FICHIER"")"
            Range("d" & i).Select
 
 
            'abre el primer archivo encontrado
            Application.DisplayAlerts = False
            Workbooks.Open Filename:=.FoundFiles(i)
            Workbooks.Open Filename:=.FoundFiles(i), UpdateLinks:=0
            ActiveWindow.Visible = True
 
            'Cambia a la primera hoja del archivo
            Worksheets(1).Activate
 
            Dim Sht As Worksheet
            Dim a As Integer
            Dim cpt As Integer
            a = 5
            cpt = 0
            For Each Sht In ActiveWorkbook.Worksheets
                Workbooks("EXPERIMENTO.xls").Worksheets("Feuil1").Cells(i, a).Value = Sht.Name
 
                If Workbooks("EXPERIMENTO.xls").Worksheets("Feuil1").Cells(i, a).Value = "Datas" Or Workbooks("EXPERIMENTO.xls").Worksheets("Feuil1").Cells(i, a).Value = "amd" Or Workbooks("EXPERIMENTO.xls").Worksheets("Feuil1").Cells(i, a).Value = "gravure" Or Workbooks("EXPERIMENTO.xls").Worksheets("Feuil1").Cells(i, a).Value = "data" Or Workbooks("EXPERIMENTO.xls").Worksheets("Feuil1").Cells(i, a).Value = "datas" Then
                    cpt = cpt + 1
                    Windows("EXPERIMENTO.xls").Activate
                    Range("c" & i).Select
                    ActiveCell.FormulaR1C1 = cpt
                    If Workbooks("EXPERIMENTO.xls").Worksheets("Feuil1").Cells(i, a).Value = "Datas" Or Workbooks("EXPERIMENTO.xls").Worksheets("Feuil1").Cells(i, a).Value = "data" Or Workbooks("EXPERIMENTO.xls").Worksheets("Feuil1").Cells(i, a).Value = "datas" Then
                    Range("d" & i).Select
                    ActiveCell.FormulaR1C1 = Cells(i, a).Value
                    End If
                End If
                a = a + 1
            Next
                Windows("EXPERIMENTO.xls").ActivatePrevious
                'la siguiente linea cierra el archivo *.XLS
                ActiveWindow.Close
            Next i
    Else
        MsgBox "Il n'y a pas fichier Excel, le dossier c'est pas correct."
        Exit Sub
    End If
 
 
        'Inserta 3 lineas para agregar los titulos a las columnas
        Rows("1:3").Select
        Selection.Insert Shift:=xlDown
        Range("A12").Select
        ActiveSheet.Shapes("Button 1").Select
        Rows("3:3").Select
 
End With
    'agrega los nombres a las columnas y sus caracteristicas
    Selection.Font.Bold = True
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "ADRESSE"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "HYPER LIEN"
    Range("e3").Select
    ActiveCell.FormulaR1C1 = "FEUILLES DANS LES FICHIERS -->"
    Range("D3").Select
    'Selecciona el renglon 3 y le agrega el autofiltro
    Rows("3:3").Select
    Selection.AutoFilter
    'Bloquea los primeros tres renglones para que siempre esten visibles
    ActiveWindow.SplitRow = 3
    'Selecciona la celda B1 y le agrega la fecha y la hora
    ActiveWindow.FreezePanes = True
    Range("b1").Select
    ActiveCell.FormulaR1C1 = "=NOW()"
    'Selecciona la celda A1 y agrega el titulo
    Range("a1").Select
    ActiveCell.FormulaR1C1 = "La dernier mise a jour c'était effectué le:"
    'La celda A1 es alineada a la derecha
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Cells.EntireColumn.AutoFit
 
    'Alinea a ala izquierda la columna "A" a partir del renglon 4
    Range("A4:A" & i).Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
Range("d1").Select
ActiveCell.FormulaR1C1 = "Fichiers trouvées: "
Range("e1").Select
ActiveCell.FormulaR1C1 = i - 1
Range("d1").Select
With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("E1").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 
Cells.EntireColumn.AutoFit
MsgBox "Avant vous continuez: Enregistrez tous et fermez-les"
MsgBox "Avez vous enregistré et fermé tous?????"
 
Dim t As Integer
t = 3
For t = 3 To i + 2
Range("c" & t).Select
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
If ActiveCell.Value = "3" Then
    With Selection.Interior
        .ColorIndex = 8
        .Pattern = xlSolid
    End With
    'ééééééééééééééééééééééééééééééééééééééééééééééééééééééééééééééééééééééééé
    If Range("d" & t) = "Datas" Then
    '[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[
        Workbooks.Open Filename:=Range("a" & t)
        Sheets("Datas").Select
        Range("A2:G2").Select
        Selection.End(xlDown).Select
        Range("A2:G2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Windows("EXPERIMENTO.xls").Activate
        Sheets("CP ou EM").Select
        Range("b1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        MsgBox Application.WorksheetFunction.Count(ThisWorkbook.Sheets("CP ou EM").Range("b1:b65536"))
     '[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[
        Windows("EXPERIMENTO.xls").ActivatePrevious
        ActiveWindow.Close
        Sheets("Feuil1").Select
    End If
 
 
   If Range("d" & t) = "datas" Then
    '[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[
        Workbooks.Open Filename:=Range("a" & t)
        Sheets("datas").Select
        Range("A2:G2").Select
        Selection.End(xlDown).Select
        Range("A2:G2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Windows("EXPERIMENTO.xls").Activate
        Sheets("CP ou EM").Select
        Range("b1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
     '[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[
        Windows("EXPERIMENTO.xls").ActivatePrevious
        ActiveWindow.Close
        Sheets("Feuil1").Select
    End If
 
 
    If Range("d" & t) = "data" Then
    '[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[
        Workbooks.Open Filename:=Range("a" & t)
        Sheets("datas").Select
        Range("A2:G2").Select
        Selection.End(xlDown).Select
        Range("A2:G2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Windows("EXPERIMENTO.xls").Activate
        Sheets("CP ou EM").Select
        Range("b1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
     '[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[
        Windows("EXPERIMENTO.xls").ActivatePrevious
        ActiveWindow.Close
        Sheets("Feuil1").Select
    End If
 
 
 
 
 
 
    'ééééééééééééééééééééééééééééééééééééééééééééééééééééééééééééééééééééééééé
End If
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
t = t + 1
Next t
    'Alinea a ala izquierda la columna "A" a partir del renglon 4
    Range("d4:d" & i + 4).Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 
End Sub

mon problem comence avec cette ligne:

Code :

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

If Range("d" & t) = "data" Then

merci beaucoup

[garion28]

il te met quel erreur ?

le problème si tu importe 200 fichier de 136 ligne chacun sur une seul feuille, tu va etre en dépassement de capacité (trop de ligne a copier et pas assez de place)

[Krovax]

Je n'ai pas regarder ton code un peu long et trop de .select qui l'alourdisse et vont le rendre très lent surtout que tu n'utilise pas application.screenupdating

mais pour copier dans la première ligne vide

Code :

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

range("A"& derniereligne+1).paste

Tu remplis la variable derniereligne avec une des nombreuses méthodes que l'on ta donné

[casefayere]

en attendant, meme si j'en oublie, il faut eliminer les codes inutiles
Sub CHERCHER()

Code :

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

1
2
3
4
5
'elimina los datos de la busqueda anterior
Sheets("feuil1").Cells.delete
Sheets("CP").Cells.delete
Sheets("EM").Cells.delete
.......

[sergio_gr66]

il te met quel erreur ?

Non, pas d'erreur, mais je ne sais pas comment faire, je peux ouvrir le fichier avec les donnees et les coller, mais je ne sais pas como faire un compter puor coller les prochains donnees en dessous, sans eliminir les anciens donnees.

[Krovax]

en utilisant le petit bout de code que je t'ais donné... ou alors si ca ne fonctionne pas montre nous ou tu l'as intégré. (juste la zone ou tu l'a mis pas forcément tout le code )

[sergio_gr66]

en utilisant le petit bout de code que je t'ais donné... ou alors si ca ne fonctionne pas montre nous ou tu l'as intégré. (juste la zone ou tu l'a mis pas forcément tout le code )

Sa marche pas, la macro colle les données au deçus les premieres donnees, je vous montre la zone ou j'ai adjoute 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
 
If Range("d" & t) = "datas" Then
        Workbooks.Open Filename:=Range("a" & t)
        Sheets("datas").Select
        Range("A2:G2").Select
        Selection.End(xlDown).Select
        Range("A2:G2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Windows("EXPERIMENTO.xls").Activate
        Sheets("CP ou EM").Select
        Range("a1").Select
        Range("a" & derniereligne + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Windows("EXPERIMENTO.xls").ActivatePrevious
        ActiveWindow.Close
        Sheets("Feuil1").Select
    End If