Besoin d'une macro loop

Sub Principale()
Dim Plage As Range
Dim Lignes(), i As Long
Dim Texte As String
Dim Flag As Boolean
Dim maligne As Integer
Set Plage = Sheets("Feuil1").Columns(1) 'plage de recherche colonne A
Texte = "S/Total R2017"   'expression cherchée
Flag = Find_Next(Plage, Texte, Lignes())  'appel de la fonction
If Flag Then  'si fonction retourne Vrai = expression trouvée dans la plage
    For i = LBound(Lignes) To UBound(Lignes)   'restitution des lignes correspondantes
       maligne = Lignes(i)
  Range("A" & maligne - 3).Copy ActiveSheet.Range("A" & maligne) 'copier coller
Application.CutCopyMode = False
   Next i
Else
    MsgBox "L'expression : " & Texte & " n'a pas été trouvée dans la plage : " & Plage.Address
End If
End Sub

'Sources : Michel_m
'http://www.commentcamarche.net/forum/affich-31432413-importation-de-donnees-sans-doublons#9
Function Find_Next(Rng As Range, Texte As String, Tbl()) As Boolean
Dim Nbre As Integer, Lig As Long, Cptr As Long

    Nbre = Application.CountIf(Rng, Texte)
    If Nbre > 0 Then
        ReDim Tbl(Nbre - 1)
        Lig = 1
        For Cptr = 0 To Nbre - 1
            Lig = Rng.Find(Texte, Cells(Lig, Rng.Column), xlValues).Row
            Tbl(Cptr) = Lig
        Next
    Else
        GoTo Absent
    End If
    Find_Next = True
    Exit Function
Absent:
    Find_Next = False
End Function

Option Explicit
Private Sub CommandButton1_Click()
 Dim Tableau() As String
 Dim nom As String
 Dim FL1 As Worksheet, NoCol, i As Integer
Dim NoLig As Long, Var As Variant
    Set FL1 = Worksheets("Feuil1")
    NoCol = 2 'lecture de la colonne B
    For NoLig = 1 To Split(FL1.UsedRange.Address, "$")(4)
        Var = FL1.Cells(NoLig, NoCol)
   'découpe la chaine en fonction des espaces " "
    'le résultat de la fonction Split est stocké dans un tableau
    Tableau = Split(Var, " ")
               For i = 0 To UBound(Tableau)
            '  Debug.Print Tableau(i)
             Next i
        nom = Tableau(0) '1èrechaine = S/Total
        If nom = "S/Total" Then
      Range("B" & NoLig - 3).Copy ActiveSheet.Range("B" & NoLig) 'copier coller
Application.CutCopyMode = False
       End If
   Next
    Set FL1 = Nothing
End Sub

 nom = Tableau(0) '1èrechaine = S/Total

 nom = Tableau(1) '2ème chaine = R2017/00027 

Option Explicit
Private Sub CommandButton1_Click()
 Dim Tableau() As String
 Dim nom As String
 Dim FL1 As Worksheet, NoCol, i As Integer
Dim NoLig As Long, Var As Variant
    Set FL1 = Worksheets("Feuil1")
    NoCol = 2 'lecture de la colonne B
    For NoLig = 1 To Split(FL1.UsedRange.Address, "$")(4)
        Var = FL1.Cells(NoLig, NoCol)
   'découpe la chaine en fonction des espaces " "
    'le résultat de la fonction Split est stocké dans un tableau
    Tableau = Split(Var, " ")
               For i = 0 To UBound(Tableau)
             Debug.Print Tableau(i)
             Next i
             nom = Tableau(0) '1èrechaine = S/Total
         If nom = "S/Total" Then
         MsgBox Tableau(1) '2ème chaine = R2017/00027
     ' Range("B" & NoLig - 3).Copy ActiveSheet.Range("B" & NoLig) 'copier coller
'Application.CutCopyMode = False
       End If
   Next
    Set FL1 = Nothing
End Sub

Option Explicit
Private Sub CommandButton1_Click()
 Dim Tableau() As String
 Dim nom As String
 Dim nom_2 As String
 Dim FL1 As Worksheet, NoCol, i As Integer
Dim NoLig As Long, Var As Variant
    Set FL1 = Worksheets("Feuil1")
    NoCol = 2 'lecture de la colonne B
    For NoLig = 1 To Split(FL1.UsedRange.Address, "$")(4)
        Var = FL1.Cells(NoLig, NoCol)
   'découpe la chaine en fonction des  "/"
    'le résultat de la fonction Split est stocké dans un tableau
    Tableau = Split(Var, "/")
               For i = 0 To UBound(Tableau)
              Debug.Print Tableau(i)
             Next i
             nom = Tableau(0) '1èrechaine = S
         If nom = "S" Then
          nom_2 = Tableau(1)  '2ème chaine = Total R2017
           If nom_2 = "Total R2017" Then
         Range("B" & NoLig - 3).Copy ActiveSheet.Range("B" & NoLig) 'copier coller
       Application.CutCopyMode = False
       End If
       End If
   Next
    Set FL1 = Nothing
End Sub

Option Explicit
Private Sub CommandButton1_Click()
 Dim Tableau() As String
 Dim nom As String
 Dim nom_2 As String
 Dim FL1 As Worksheet, NoCol, i As Integer
Dim NoLig As Long, Var As Variant
Dim DernLigne As Long
DernLigne = Range("B1048576").End(xlUp).Row
    Set FL1 = Worksheets("Feuil1")
    NoCol = 2 'lecture de la colonne B
    For NoLig = 1 To DernLigne
        Var = FL1.Cells(NoLig, NoCol)
   'découpe la chaine en fonction des espaces "/"
    'le résultat de la fonction Split est stocké dans un tableau
    Tableau = Split(Var, "/")
               For i = 0 To UBound(Tableau)
              Debug.Print Tableau(i)
             Next i
             nom = Tableau(0) '1èrechaine = S
         If nom = "S" Then
          nom_2 = Tableau(1)  '2ème chaine = Total R2017
           If nom_2 = "Total R2017" Then
         Range("B" & NoLig - 3).Copy ActiveSheet.Range("B" & NoLig) 'copier coller
       Application.CutCopyMode = False
       End If
       End If
   Next
    Set FL1 = Nothing
End Sub

Option Explicit
Private Sub CommandButton1_Click()
 Dim Tableau() As String
 Dim nom As String
 Dim FL1 As Worksheet, NoCol, i As Integer
Dim NoLig As Long, Var As Variant
Dim DernLigne As Long
DernLigne = Range("B1048576").End(xlUp).Row
    Set FL1 = Worksheets("Feuil1")
    NoCol = 2 'lecture de la colonne B
    For NoLig = 1 To DernLigne
        Var = FL1.Cells(NoLig, NoCol)
   nom = Left(Var, 13)
   If nom = "S/Total R2017" Then
        Range("B" & NoLig - 3).Copy ActiveSheet.Range("B" & NoLig) 'copier coller
       Application.CutCopyMode = False
    End If
   Next
    Set FL1 = Nothing
End Sub