Bonjour,

Je reviens sur le forum après plusieurs tentatives.

J'ai réussi à adapter un code. Il fonctionne et effectue le calcul demandé mais je souhaiterai l'appliquer sur plusieurs fichiers en le mettant dans un classeur à part et insérer un bouton qui me permettra de l'exécuter sur l'ensemble des classeurs

mais malheureusement quand j'essaye d'intéger la focntion DIR ca ne marche plus et j'ai du mal à voir d'où vient le probléme.


Je joins mon code sans la fonction DIR
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
  Sub extraction_calcul()
 
Dim nl As Integer
Dim i As Integer
Dim j As Integer
Dim nb_listedoc As Long
Dim nbligne As Long
 
nbligne = Application.CountA(Sheets("Sogelink").Range("G:G"))
 
Set myrange = Sheets("Sogelink").Range("G2:G" & nbligne)
 
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
 
Worksheets("Sogelink").Copy before:=Worksheets("Liste_documents")
 
ActiveSheet.Name = "Copie fichier de base"
 
Sheets("Copie fichier de base").Range("A:F").Delete
Sheets("Copie fichier de base").Range("B:I").Delete
Sheets("Copie fichier de base").Range("C:D").Delete
Sheets("Copie fichier de base").Range("D:E").Delete
Sheets("Copie fichier de base").Range("F:F").Delete
 
With Sheets("Copie fichier de base")
 
Range("A:E").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
 
Sheets("Copie fichier de base").Range("A1:E65000").AdvancedFilter Action:=xlFilterCopy, criteriarange:=Sheets("Copie fichier de base").Range("A1:A65000"), copytorange:=Sheets("Liste_documents").Range("A1:E1"), Unique:=True
 
End With
 
With Sheets("Liste_documents")
 
nb_listedoc = Application.CountA(Sheets("Liste_documents").Range("A:A"))
 
For nl = 2 To nb_listedoc
 
Sheets("Liste_documents").Columns("F").Cells(nl) = Application.WorksheetFunction.CountIfs(myrange, Sheets("Liste_documents").Columns("A").Cells(nl))
 
Next nl
 
Sheets("Liste_documents").Columns("F").Cells(1) = "nbre_de_lignes"
 
End With
 
With Sheets("Liste_documents")
 
For i = 2 To nb_listedoc
 
Sheets("Liste_documents").Cells(i, 7).Value = Sheets("Liste_documents").Cells(i, 4).Value * Sheets("Liste_documents").Cells(i, 6).Value
 
Sheets("Liste_documents").Cells(i, 8).Value = Sheets("Liste_documents").Cells(i, 5).Value * Sheets("Liste_documents").Cells(i, 6).Value
 
Next i
 
Sheets("Liste_documents").Columns("G").Cells(1) = "Total pages lignes"
 
Sheets("Liste_documents").Columns("H").Cells(1) = "Total unit?s lignes"
 
End With
 
Sheets("Copie fichier de base").Delete
 
ActiveWorkbook.Close SaveChanges:=True
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub
Merci de votre aide

cordialement,