Public Sub test()
Application.ScreenUpdating = False
Dim listeDepartement() As String, i As Integer, j As Integer, wbk As Workbook, curSheet As Worksheet
listeDepartement = RecupListeDepartements
For i = LBound(listeDepartement) To UBound(listeDepartement)
Set wbk = Application.Workbooks.Add(xlWBATWorksheet)
For Each curSheet In ThisWorkbook.Worksheets
wbk.Sheets.Add after:=wbk.Sheets(wbk.Sheets.Count)
With wbk.Sheets(wbk.Sheets.Count)
.Name = curSheet.Name
curSheet.Rows(1).Copy .Range("A1")
For j = 2 To curSheet.Range("G" & curSheet.Rows.Count).End(xlUp).Row
If curSheet.Range("G" & j).Text = listeDepartement(i) Then
curSheet.Rows(j).Copy .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
End If
Next j
End With
Next curSheet
Application.DisplayAlerts = False: wbk.Sheets(1).Delete: Application.DisplayAlerts = True
wbk.SaveAs (ThisWorkbook.Path & "\" & Replace(listeDepartement(i), "/", ""))
wbk.Close False
Next i
Application.ScreenUpdating = True
End Sub
Private Function RecupListeDepartements() As String()
Dim curSheet As Worksheet, tableauDepartements() As String, i As Integer, compteurTableau As Integer
ReDim tableauDepartements(1 To 1)
For Each curSheet In ThisWorkbook.Worksheets
For i = 2 To curSheet.Range("G" & curSheet.Rows.Count).End(xlUp).Row
If Not verifDejaSaisi(tableauDepartements, curSheet.Range("G" & i).Text) Then
compteurTableau = compteurTableau + 1
ReDim Preserve tableauDepartements(1 To compteurTableau)
tableauDepartements(UBound(tableauDepartements)) = curSheet.Range("G" & i).Text
End If
Next i
Next curSheet
RecupListeDepartements = tableauDepartements
End Function
Private Function verifDejaSaisi(tableau() As String, valeur As String) As Boolean
Dim i As Integer
verifDejaSaisi = False
For i = LBound(tableau) To UBound(tableau)
If tableau(i) = valeur Then verifDejaSaisi = True: Exit Function
Next i
End Function