Sub ghj()

Dim wB1 As Workbook
Set wB1 = Workbooks(ActiveWorkbook.Name)
For i = 1 To wB1.Sheets("Лист2").Cells.SpecialCells(xlLastCell).Row
For s = 3 To 3
If Len(wB1.Sheets("Лист2").Cells(i, 3)) = 9 Then
Cells(i, 30) = "=REPT(0,1)&RC[-27]"
   
          
     End If
  Next
   Next
For i = 1 To wB1.Sheets("Лист2").Cells.SpecialCells(xlLastCell).Row
For s = 3 To 3
If Len(wB1.Sheets("Лист2").Cells(i, 3)) = 9 Then
Cells(i, 30).Cut
Cells(i, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
 End If
  Next
   Next

End Sub

Sub ВПР()

Dim LastRow As Long, i As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LastRow
If Len(Cells(i, 9)) = 7 Then
Cells(i, 21) = VLOOKUP(RC[-12],[Файл.xlsx]резерв'!$A:$B;2;0)
    Next
End Sub

Sub xlsb()
 Dim A As String
 Dim B As String
     A = InputBox("Введите данные", "Ввод данных")
   B = InputBox("Введите данные", "Ввод данных")
    Dim sFolder As String, sFiles As String
      With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
      Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls")
    Do While sFiles <> ""
            Workbooks.Open sFolder & sFiles
    On Error Resume Next: Err.Clear
     
    If Val(Application.Version) < 12 Then Exit Sub
   
   oldName$ = ActiveWorkbook.FullName
 
      If UCase$(oldName$) Like "*.XLSB" Then Exit Sub
   
   newName$ = Left(oldName$, InStrRev(oldName$, ".")) & "xlsb"
     
   ActiveWorkbook.SaveAs newName$, xlExcel12
 
       If Err = 0 Then Kill oldName$
         Application.CutCopyMode = False
 ActiveWorkbook.Close True                    
 sFiles = Dir
    Loop
   
    Application.ScreenUpdating = True
End Sub