VBA Excel, tri en fonction de str

Sub tri()

Dim I As Variant

'Antennes'
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
If InStr(Cells(I, 1), "Parabole") <> 0 Or InStr(Cells(I, 1), "Rateau") <> 0 Or InStr(Cells(I, 1), "Wifi") <> 0 Then Cells(I, 2) = "Antenne"
Next I

'Cartes'
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
If InStr(Cells(I, 1), "Atmega") <> 0 Or InStr(Cells(I, 1), "Arduino") <> 0 Or InStr(Cells(I, 1), "Polulu") <> 0 Or InStr(Cells(I, 1), "Driver") <> 0 Then Cells(I, 2) = "Carte"
Next I

'Liaisons'
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
If InStr(Cells(I, 1), "BusCAN") <> 0 Or InStr(Cells(I, 1), "RS232") <> 0 Or InStr(Cells(I, 1), "LI-FI") <> 0 Or InStr(Cells(I, 1), "SPI") <> 0 Or InStr(Cells(I, 1), "I2C") <> 0 Or InStr(Cells(I, 1), "RS512") <> 0 Or InStr(Cells(I, 1), "LI-FI") <> 0 Or InStr(Cells(I, 1), "Bluetooth") <> 0 Or InStr(Cells(I, 1), "Ethernet") <> 0 Then Cells(I, 2) = "Liaison"
Next I


End Sub

Public classeur2 As String
Public classeur3 As String
Public mailclient As String
Public lignesenretard As Integer
Public OTDcible As String
Public nomODTcible As String

Option Explicit




Sub Envoi_OTD()
Dim a As Variant, b As Variant
Dim classeur1 As String
Dim I As Variant, J As Variant
Dim clienta As String, clientb As String
Dim testclient As Integer
testclient = 2

MsgBox ("Séléctionner le fichier OTD:")
ChDrive "K:" ' Choix du lecteur
ChDir "K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD" 'Choix du répertoire
a = Application.GetOpenFilename("fichier excel (*.xlsx), *.xlsx", _
, "Quel sera le PJ à renseigner ?", , True)

Select Case TypeName(a)
Case Is = "Boolean"
Exit Sub
Case Else
For b = LBound(a) To UBound(a)
Workbooks.Open a(b)
Next
End Select
nomODTcible = ActiveWorkbook.Name
OTDcible = ActiveWorkbook.FullName
Windows(nomODTcible).Close False

classeur1 = ActiveWorkbook.Name
Application.ScreenUpdating = False

For I = 2 To Range("B" & Rows.Count).End(xlUp).Row
    If Cells(I, 1) <> "" Then
        'clienta = Cells(I, 2)
        clienta = StrConv(Cells(I, 2).Value, vbProperCase)
        'Cells(I, 2) = StrConv(Cells(I, 2).Value, vbProperCase)
        'clienta = Cells(I, 2).Value
        Workbooks.Open ("K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD\OTD.xlsx")
        classeur2 = ActiveWorkbook.Name
        Windows(classeur2).Activate
        ChDir "K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD"
        ActiveWorkbook.SaveAs Filename:="OTD_" & clienta & classeur2
        classeur2 = ActiveWorkbook.Name
        Windows(classeur2).Activate
        Do While Cells(testclient, 2) <> ""
            If Cells(testclient, 2) = "" Then Exit Do
            If clienta <> StrConv(Cells(testclient, 2), vbProperCase) Then Cells(testclient, 2).EntireRow.Delete
            If clienta = StrConv(Cells(testclient, 2), vbProperCase) Then testclient = testclient + 1
        Loop
        'lignesenretard
        For J = 2 To Range("B" & Rows.Count).End(xlUp).Row
            If Cells(J, 20) = "" And Cells(J, 2) <> "" Then lignesenretard = lignesenretard + 1
        Next J
        
        
        Columns("T:T").Select
        Selection.TextToColumns Destination:=Range("T1"), DataType:=xlFixedWidth, _
                FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
                
        Dim DernLigne As Long
        DernLigne = Range("A" & Rows.Count).End(xlUp).Row
        
        Rows("1:1").Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        
        'Nb de lignes
        Range("M1").Select
        ActiveCell.FormulaR1C1 = "Nb de lignes:"
        Range("N1").Select
        ActiveCell.FormulaR1C1 = (DernLigne - 1)
        
        'Nb cellule non vides
        Range("P1").Select
        ActiveCell.FormulaR1C1 = "Lignes non vides:"
        Range("Q1").Select
        ActiveCell.FormulaR1C1 = "=COUNTA(R[2]C[3]:R[199]C[3])"
        
        Range("S1").Select
        ActiveCell.FormulaR1C1 = "OTD:"
        
        'Cellule non vides/Nb de ligne
        Range("T1").Select
        ActiveCell.FormulaR1C1 = "=RC[-3]/RC[-6]"
            
        
        Range("A1").Select
        Windows(classeur2).Close True
        
        
        Workbooks.Open ("K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD\Fournisseurs\_Fournisseurs_.xls")
        classeur3 = ActiveWorkbook.Name
        Windows(classeur3).Activate
        For J = 2 To Range("A" & Rows.Count).End(xlUp).Row
            If clienta = StrConv(Cells(J, 1), vbProperCase) Then
                If Cells(J, 2) = "" Then
                    MsgBox "ATTENTION aucun Email Fournisseur n'est renseigné pour le client" & clienta
                    ChDir "K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD"
                    Kill classeur2
                    Exit Sub
                Else:
                    mailclient = Cells(J, 2).Value
                    Call mail
                    ChDir "K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD"
                    Kill classeur2
                End If
            End If
            
        Next J
    Windows(classeur3).Close False
    End If
    
lignesenretard = 0
testclient = 2
Windows(classeur1).Activate
 
Next I


MsgBox ("Mail(s) envoyé(s)")


Application.ScreenUpdating = True
End Sub

Sub mail()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim olFormatHTML As String





                
                Set OutApp = CreateObject("Outlook.Application")
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                   .To = mailclient
                   .Subject = "OTD"
                   .Body = "Veuillez trouver ci-joint le fichier ODT" & vbCrLf & vbCrLf & "Cordialement"
                   .Attachments.Add "K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD\" & classeur2
                   .Send
                End With
                Set OutApp = Nothing
End Sub