Sub traitement()
'Déclarer les variables
Dim pro, y, NomTableau() As String
Dim i, k, j, x, last, lastmail, lastcount, lastcount1 As Integer
c = 0: k = 0: i = 0: j = 0
last = Worksheets("importation").Range("A65536").End(xlUp).Row
pro = "*418-6*"
'redimensionne le tableau en fonction du nombre de variable pro
x = Application.CountIf(Range("A1:A" & last), pro)
ReDim NomTableau(x)
'stockage dans NomTableau() les numéro ligne qui contienne la variable pro
With Worksheets("importation").Range("A1:A" & last)
Set c = .Find(pro, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
NomTableau(j) = c.Row
j = j + 1
Do
Set c = .FindNext(c)
NomTableau(j) = c.Row
If j < x Then j = j + 1
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
'redimmensionne le tableau pck le dernier element est égal au premier
ReDim Preserve NomTableau(0 To (x - 1))
For j = 0 To x - 1
If j < x - 1 Then
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
t = 0
Worksheets(Worksheets.Count).Range("A1:G" & NomTableau(j + 1) - NomTableau(j) - 13) = Worksheets("importation").Range("A" & NomTableau(j) + 5 & ":G" & NomTableau(j + 1) - 9).Value
Else
End If
'trouve le numéro de fournisseur dans le texte et le trim
y = Val(Mid(Sheets(Worksheets.Count).Range("A1"), InStr(Sheets(Worksheets.Count).Range("A1"), ":") + 1))
y = Trim(y)
'lorsque le fournisseur a plus d'une page il copie la 2em apres la premiere et vide les cellule de la 2em
If Worksheets(Worksheets.Count - 1).Name = y Then
lastcount = Worksheets(Worksheets.Count).Range("A65536").End(xlUp).Row
lastcount1 = Worksheets(Worksheets.Count - 1).Range("A65536").End(xlUp).Row
Worksheets(Worksheets.Count - 1).Range("A" & lastcount1 + 2 & ":G" & lastcount1 + lastcount - 4) = Worksheets(Worksheets.Count).Range("A6" & ":G" & lastcount).Value
Worksheets(Worksheets.Count).Range("A1" & ":G" & lastcount).Value = ""
'si juste une page la renomme le no de fournisseur et vérifie avec les emial fournisseur pour des nouveau
Else
Worksheets(Worksheets.Count).Name = y
lastmail = Worksheets("email").Range("A65536").End(xlUp).Row
Set c = Worksheets("email").Range("A1:A" & lastmail).Find(Trim(y), LookIn:=xlValues)
If Not c Is Nothing Then
Else
Worksheets("email").Range("A" & lastmail + 1) = y
Worksheets("email").Range("B" & lastmail + 1) = Sheets(Worksheets.Count).Range("A1")
End If
End If
Next j
End Sub