Discussion :

[roch2a]

Bonjour à toutes et tous ,

Voilà j'ai un gros tableau de données que j'ai simplifié pour obtenir votre aide;
Dans ce tableau j'ai deux colonnes : Nature de prestation et assurés voir la photo
j'ai une macro un peu bancale mais fonctionnelle qui me permet de filtrer une nature de prestation exemple ABA et de compter le nombre d'assurés sans doublon qui bénéficient de cette prestation.
Dans mon exemple si on filtre ABA on obtient 4 assurés uniques.

Ma question comment faire pour que ma macro fasse ce calcul automatiquement pour chaque nature de prestation donc pour ABA, ABG, ATP ect ?
Cela sans que j'ai à remplir mon inputbox.

Voici ma 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
Sub AssUniq()
 
Application.ScreenUpdating = False
 
'On va compter le nombre d'assurés uniques ayant utilisé une nature de prestation à choisir
 
Dim MonFiltre As String
'Dim MonOnglet As String
 
MonFiltre = InputBox("Choississez la nature de prestation")
'MonOnglet = InputBox("Entrez le nom de l'onglet")
Sheets("Donnees").Activate
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
 
    Rows("1:1").Select
    Selection.AutoFilter
    'ActiveSheet.Range("$A$1:$Z" & DernLigne).AutoFilter Field:=2, Criteria1:="ABA"
    ActiveSheet.Range("$A$1:$Z" & DernLigne).AutoFilter Field:=2, Criteria1:=MonFiltre
    Range("A1").Select
 
    Range("A1:Z" & DernLigne).Select
    Selection.Copy
'    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = MonFiltre & "_" & "AssUniq"
    ActiveSheet.Paste
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("C:C").Select
    ActiveSheet.Range("$C$1:$C" & DernLigne).RemoveDuplicates Columns:=1, Header:= _
        xlYes
 
   Range("A1").Select
 
  ActiveSheet.Cells(Rows.Count, "A").End(xlUp)(2).Offset(, 2) = Application.WorksheetFunction.CountA(Columns(3))
 
  Sheets("Donnees").Select
    ActiveSheet.Range("$A$1:$Z" & DernLigne).AutoFilter Field:=2
 
Application.ScreenUpdating = True
End Sub

et un exemple de mon tableau source

Merci de votre aide.