Sub perenos2()
Dim i As Long, i_n As Long, j As Long, i2 As Long, n As Long, j_n As Long
Dim ActWB As Workbook, WB As Workbook
Dim sht As Worksheet
Dim nameWB As String, path1 As String, Ras As String, nameWB2 As String, nameWB3 As String
Dim shtname As String, key As String
shtname = "ОПФ"
Dim nameSKV As Object
Ras = ".xls"
j_n = 31
Application.ScreenUpdating = False
For j = 2 To j_n
   If Dir(ThisWorkbook.Path & "\" & j & Ras) <> "" Then
     Set nameSKV = CreateObject("scripting.dictionary")
      If ActWB Is Nothing Then
         Workbooks.Open ThisWorkbook.Path & "\" & j & Ras
         Set ActWB = ActiveWorkbook
      End If
      i_n = ActWB.Worksheets(shtname).Cells(Rows.Count, 4).End(xlUp).Row
      nameWB = ActWB.Name
      path1 = ActWB.Path
      nameWB2 = Left(nameWB, Len(nameWB) - Len(Ras))
      For i = 7 To i_n
         key = ActWB.Worksheets(shtname).Cells(i, 7) & ActWB.Worksheets(shtname).Cells(i, 8)
         If Not nameSKV.exists(key) Then
            nameSKV.Add key, ActWB.Worksheets(shtname).Cells(i, 19)
         End If
      Next i
      For i2 = 1 To 30
        n = nameWB2 + i2
        If Dir(path1 & "\" & n & Ras) <> "" Then
           nameWB3 = n
           Exit For
        Else
           If j < j_n Then
             j = j + 1
           Else
             Exit Sub
           End If
        End If
      Next i2
      Workbooks.Open (path1 & "\" & nameWB3 & Ras)
      Set WB = ActiveWorkbook
      i_n = WB.Worksheets(shtname).Cells(Rows.Count, 4).End(xlUp).Row
      For i = 1 To i_n
         key = WB.Worksheets(shtname).Cells(i, 7) & WB.Worksheets(shtname).Cells(i, 8)
         If nameSKV.exists(key) Then
            WB.Worksheets(shtname).Cells(i, 31) = nameSKV(key)
         End If
      Next i
      Application.DisplayAlerts = False
      ActWB.Close , True
      Application.DisplayAlerts = True
      Set ActWB = WB
   End If
Next j
Application.ScreenUpdating = True
End Sub

Sub perenos2()
Dim i As Long, i_n As Long, j As Long, i2 As Long, n As Long, j_n As Long
Dim ActWB As Workbook, WB As Workbook
Dim sht As Worksheet
Dim nameWB As String, path1 As String, Ras As String, nameWB2 As String, nameWB3 As String
Dim shtname As String, key As String
shtname = "ОПФ"
Dim nameSKV As Object
Ras = ".xlsx"
j_n = 31
Application.ScreenUpdating = False
For j = 1 To j_n
   If Dir(ThisWorkbook.Path & "\" & j & Ras) <> "" Then
     Set nameSKV = CreateObject("scripting.dictionary")
      If ActWB Is Nothing Then
         Workbooks.Open ThisWorkbook.Path & "\" & j & Ras
         Set ActWB = ActiveWorkbook
      End If
      i_n = ActWB.Worksheets(shtname).Cells(Rows.Count, 4).End(xlUp).Row
      nameWB = ActWB.Name
      path1 = ActWB.Path
      nameWB2 = Left(nameWB, Len(nameWB) - Len(Ras))
      For i = 7 To i_n
         key = ActWB.Worksheets(shtname).Cells(i, 7) & ActWB.Worksheets(shtname).Cells(i, 8)
         If key <> "" Then
           If Not nameSKV.exists(key) Then
              nameSKV.Add key, ActWB.Worksheets(shtname).Cells(i, 19)
           End If
         End If
      Next i
      For i2 = 1 To 30
        n = nameWB2 + i2
        If Dir(path1 & "\" & n & Ras) <> "" Then
           nameWB3 = n
           Exit For
        Else
           If j < j_n Then
             j = j + 1
           Else
             Exit Sub
           End If
        End If
      Next i2
      Workbooks.Open (path1 & "\" & nameWB3 & Ras)
      Set WB = ActiveWorkbook
      i_n = WB.Worksheets(shtname).Cells(Rows.Count, 4).End(xlUp).Row
      For i = 1 To i_n
         key = WB.Worksheets(shtname).Cells(i, 7) & WB.Worksheets(shtname).Cells(i, 8)
         If nameSKV.exists(key) Then
            WB.Worksheets(shtname).Cells(i, 31) = nameSKV(key)
         End If
      Next i
      Application.DisplayAlerts = False
      ActWB.Close (True)
      Application.DisplayAlerts = True
      Set ActWB = WB
   End If
Next j
Application.ScreenUpdating = True
End Sub