Sub GetSlesh6_7()
Dim mo As Object
Dim n As Integer
Dim i As Long
Dim iLastRow As Long
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
With CreateObject("VBScript.RegExp")
  .Global = True
  .Pattern = "[^/]+"
  For i = 1 To iLastRow
    If .Test(Cells(i, "A")) Then
      Set mo = .Execute(Cells(i, "A"))
      If mo.Count >= 7 Then
         Cells(i, "D") = Replace(Cells(i, "A"), mo(5) & "/", "")
      End If
    End If
  Next
End With
End Sub