Sub Macro1()
Dim x As Byte 'déclare la variable x
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dico As Object 'déclare la variable dico (DICtiOnnaire)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim ps As Range 'déclare la variable ps (Plage des Spécialités)
Dim cv As Range 'déclare la variable cv (Cellules Visibles)
Application.ScreenUpdating = False 'masque les changements à l'écran
Range("G1").CurrentRegion.ClearContents 'efface les anciennes données
For x = 2 To 4 Step 2 'boucle sur les colonne 2 et 4
Set dico = CreateObject("Scripting.Dictionary") 'déclare la variable dico
dl = Cells(Application.Rows.Count, x).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne x
Set pl = Range(Cells(2, x), Cells(dl, x)) 'définit la plage pl
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
If cel.Value <> "" Then dico(cel.Value) = "" 'alimente le dictionnaire dico
Next cel 'prochaine cellule de la boucle
If x = 2 Then 'condition 1 : si colonne 2
Range("G1").Value = "Nº Dossier" 'écrit "Nº Dossier" en G1
Range("G2").Resize(dico.Count).Value = Application.Transpose(dico.keys) 'récupère en G2 la liste des numéros de dossiers sans doublon verticalement
ElseIf x = 4 Then 'condition 2 : si colonne 4
Range("H1").Resize(, dico.Count).Value = dico.keys 'récupère en H1 la liste des spécialités sans doublon horizontalement
End If 'fin de la condition
Next x 'prochaine colonne de la boucle
Set ps = Range("D2:D" & dl) 'définit la plage des spécialitées ps
dl = Cells(Application.Rows.Count, 7).End(xlUp).Row 'redéfinit la dernière ligne éditée de la colonne 7 (=G)
Set pl = Range("G2:G" & dl) 'redéfinit la plage pl
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
ActiveSheet.Range("B1").AutoFilter 'lance le filtre automatique
Range("B1").AutoFilter field:=1, Criteria1:=cel.Value 'filtre la colonne B avec le numéro de dossier comme critère
For Each cv In ps.SpecialCells(xlCellTypeVisible) 'boucle sur toutes les spécialités visibles
'incrémente de 1 la cellule dans la même ligne que cv dans la colonne issue de la recherche en ligne 1 de la spécialité
Cells(cel.Row, Rows(1).Find(cv.Value, , xlValues, xlWhole).Column) = Cells(cel.Row, Rows(1).Find(cv.Value, , xlValues, xlWhole).Column) + 1
Next cv 'prochaine spécialité visible de la boucle
ActiveSheet.Range("B1").AutoFilter 'annule le filtre automatque
Next cel
Application.ScreenUpdating = True 'affiche les changements à l'écran
End Sub