Sub CopieFeuillets()
' Macro de Copie & de Tri
Sheets("Coordonnées").Unprotect
With Sheets("Coordonnées")
For i = 1 To 4
On Error Resume Next
Erase Critères
On Error GoTo 0
Select Case i
Case 1
wsn = "FORAGE"
Critères = Array("F", "FC", "FS", "FSZ")
col = "A" ' colonne dans laquelle mettre le n° de sondage, est également la colonne pour le tri
PL = 8 'première ligne des données dans wsn
tabtri = "A" & PL & ":n" ' tableau à trier
Case 2
wsn = "CPTU"
Critères = Array("C", "CR", "FC", "M")
col = "A"
PL = 7
tabtri = "A" & PL & "
"
Case 3
wsn = "Piézomètres"
Critères = Array("Z", "FSZ")
col = "B"
PL = 8
tabtri = "A" & PL & ":m"
Case 4
wsn = "Inclinomètres"
Critères = Array("I")
col = "B"
PL = 7
tabtri = "A" & PL & ":H"
End Select
.Range("$A$4:$N$64").AutoFilter Field:=4, Criteria1:=Critères, Operator:=xlFilterValues 'on filtre les données de coordonnées
Set ws = Sheets(wsn) ' ws = référence de la feuille
nl = ws.Cells(Rows.count, col).End(xlUp).Row ' nl pointeur de dernière ligne utilisée dans la feuille basé sur colonne col
If nl < PL Then nl = PL - 1
For Each R In .Range(.Range("C5"), .Range("C5").End(xlDown)).SpecialCells(xlVisible) ' on parcourt toutes les cellules sélectionnées de la colonne C, (r=cellule en cours)
Set re = ws.Range(col & ":" & col).Find(R.Value, lookat:=xlWhole) 'on recherche le n°de sondage dans la colonne col
If re Is Nothing Then 'si non trouvé
nl = nl + 1 ' on ajoute une nouvelle ligne
ws.Cells(nl, col) = R.Value ' on met le numéro de sondage en colonne col
End If
Next
With ws.Range(tabtri & nl)
.Sort key1:=.Cells(1, col), order1:=xlAscending, Header:=xlNo
End With
Next i
If Worksheets("Coordonnées").AutoFilterMode Then
Worksheets("Coordonnées").AutoFilterMode = False
End If
End With
Sheets("Coordonnées").Protect
End Sub