rx As New RegExp

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
  Dim MyConn As String, ContrInf As String
  Dim fio As String, summ As String, rashod As String, MinPlatezh As String, limit As String, sotr As String, fininst As String, ostatok As String, Cnt As Integer
  Dim fin As String, rozd As String, pasp As String, propiska As String, fakt As String, ssylka As String
  Dim nach_d As String, nach_m As String, nach_y As String, kon_d As String, kon_m As String, kon_y As String, dopki As String
  Dim rx As New RegExp, Matches As MatchCollection, Match As Match
      

  rx.MultiLine = True
  rx.Global = True
  rx.IgnoreCase = True
  Application.EnableEvents = False
  If Target.Cells.Count = 1 Then
    If Not Application.Intersect(Target, Range("cards")) Is Nothing Then
'      Target.Value = Mid(Target.Value, 2, 16)
      rx.Pattern = "\d{16}"
      Set Matches = rx.Execute(Target.Value)
      If Matches.Count > 0 Then
        Target.Value = Matches(0).Value
        ContrInf = ContractInfo(Target.Value)
        rx.Pattern = Target.Value
        Set Matches = rx.Execute(ContrInf)
        If Matches.Count > 0 Then
          ParseResponse ContrInf, fio, rashod, MinPlatezh, dopki, limit, ostatok, fin, rozd, pasp, propiska, fakt, ssylka
          Cnt = Target.Row - Range("cards").Row + 1
          
          Cells(Target.Row, 1).Value = Cnt
          Cells(Target.Row, 3).Value = fio
          Cells(Target.Row, 5).Value = rashod
          Cells(Target.Row, 4).Value = MinPlatezh
          Cells(Target.Row, 7).Value = dopki
          Cells(Target.Row, 8).Value = limit
          Cells(Target.Row, 10).Value = ostatok
          Cells(Target.Row, 11).Value = fin
          Cells(Target.Row, 12).Value = rozd
          Cells(Target.Row, 13).Value = pasp
          Cells(Target.Row, 14).Value = propiska
          Cells(Target.Row, 15).Value = fakt
          Cells(Target.Row, 27).Value = ssylka
        Else
          Cells(Target.Row, 3).Value = "нет данных"
          Target.Activate
        End If
      End If
    End If
  End If
  Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub