VBA scinder un fichier en plusieurs

Option Explicit

Sub scinder()

Dim Nwbk As Workbook
Dim chemin1, chemin2, chemin3 As String, colGdCpte As String
Dim Nmbk As String
Dim i As Long, firstline As Long, lastline As Long

chemin1 = ThisWorkbook.Path

colGdCpte = "F"

With ThisWorkbook.Sheets("RCD")
    .Unprotect
    .Range(.Range("A1"), .Range("A1").End(xlToRight).End(xlDown)).Sort key1:=.Range(colGdCpte & "2"), order1:=xlAscending, Header:=xlYes

    For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
        firstline = i
        
        While .Range(colGdCpte & i).Text = .Range(colGdCpte & i + 1).Text
            i = i + 1
        Wend
        
        Nmbk = .Range(colGdCpte & i).Value
        
        lastline = i
        
        Set Nwbk = Application.Workbooks.Add(xlWBATWorksheet)
        .Rows(1).Copy Nwbk.Sheets(1).Range("A1")
        .Rows(firstline & ":" & lastline).Copy Nwbk.Sheets(1).Range("A2")
                 
        If Dir(chemin1 & "\RCD PAR GRAND COMPTE", vbDirectory) <> "RCD PAR GRAND COMPTE" Then
        MkDir (chemin1 & "\RCD PAR GRAND COMPTE")
        End If
        chemin2 = chemin1 & "\RCD PAR GRAND COMPTE\"
        If Dir(chemin2 & Nmbk, vbDirectory) <> Nmbk Then
        MkDir (chemin2 & Nmbk)
        End If
        chemin3 = chemin2 & Nmbk
        On Error Resume Next
        Kill chemin3 & "\" & Format(Now, "yyyy" & "mm" & "dd") & "_" & Nmbk & ".xlsx"
        On Error GoTo 0
                            
        Nwbk.SaveAs chemin3 & "\" & Format(Now, "yyyy" & "mm" & "dd") & "_" & Nmbk & ".xlsx"
        
        Nwbk.Close True
    
    Next i

End With

End Sub

dim Tb as variant
tb=array("BCAC",CFIAR","CAA")

Sub Demo()
    Dim Tb As Variant, M As String, S As String, V
        Tb = Array("BCAC", "CFIAR", "CAA")
    Do
            S = InputBox(M & vbLf & vbLf & "Code ?", "Test de vérification")
         If S = "" Then Exit Sub
            V = Application.Match(S, Tb, 0)
            M = S & IIf(IsError(V), " non trouvé …", " OK !")
' ou encore :
'           M = S & IIf(IsNumeric(V), " OK !", " non trouvé …")
    Loop
End Sub

dim Tb as variant
tb=array("BCAC",CFIAR","CAA")

array("BCAC",CFIAR","CAA")