Sub test()
' Séparation des totaux
Application.ScreenUpdating = False
rech = "total ref"
i = 1
For Each sh In ActiveWorkbook.Sheets
a = sh.Name
If sh.Name = "Index" Then GoTo suite
Sheets(a).Select
Set plage = Sheets(a).Range("A:A")
With plage
Set c = .Find(rech)
If Not c Is Nothing Then
adresse = c.Address
'a = Range(adresse).Row
'Stop
Do
Range(c.Address).Offset(1, 0).Select
Selection.EntireRow.Insert
'extraction du client
NomFeuille = Right(ActiveCell.Offset(-1, 0), 7)
If WorkSheetExist("NomFeuille") = False Then
MsgBox ("nexiste pas")
Sheets.Add
ActiveSheet.Name = NomFeuille
End If
Sheets(a).Activate
ActiveCell.Offset(-1, 0).CurrentRegion.Select
Selection.Copy Destination:=Sheets(NomFeuille).Range("A1")
' Stop
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> adresse
End If: End With: Beep
suite:
Next
End Sub
Function WorkSheetExist(Sheetname As String)
Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Sheets(Sheetname)
If wSheet Is Nothing Then
WorkSheetExist = 0
On Error GoTo 0
Else 'Does exist
WorkSheetExist = 0
On Error GoTo 0
End If
Set wSheet = Nothing
End Function