Option Explicit
Sub test()
Dim c As Range
Dim dep As Integer
Dim n As Integer
Dim x As Integer
Dim flag As Boolean
Application.ScreenUpdating = False
For n = 1 To Sheets.Count
If Sheets(n).Name <> "Sites" And Sheets(n).Name <> "Liste Depts - Regions" Then
Sheets(n).Range("A2:C" & Sheets(n).Range("A65536").End(xlUp).Row + 1).ClearContents
End If
Next n
For n = 2 To Sheets("Sites").Range("B65536").End(xlUp).Row
dep = Val(Sheets("Sites").Range("B" & n)) / 1000
With Worksheets("Liste Depts - Regions").Range("A2:A" & Worksheets("Liste Depts - Regions").Range("A65536").End(xlUp).Row)
Set c = .Find(dep, LookAt:=xlWhole)
If Not c Is Nothing Then
For x = 1 To Sheets.Count
If Sheets(x).Name = .Range("C" & c.Row) Then
Sheets("Sites").Range("A" & n & ":C" & n).Copy Destination:=Sheets(x).Range("A65536").End(xlUp).Offset(1, 0)
flag = True
End If
Next x
If flag = False Then
[COLOR=red]Worksheets.Add.Name = Worksheets("Liste Depts - Regions").Range("C" & c.Row)
[/COLOR] Sheets("Sites").Range("A1:C1").Copy Destination:=ActiveSheet.Range("A1")
Sheets("Sites").Range("A" & n & ":C" & n).Copy Destination:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0)
End If
flag = False
End If
End With
Next n
Sheets("Sites").Select
Application.ScreenUpdating = True
End Sub
[\code]