Dim sadr As String
sadr = "F3:Q71,S3:AP71"
Dim SWB As Workbook
Set SWB = Workbooks("book1.xlsx")
Dim i As Long

For Each Sheet In SWB.Sheets
If Sheet.Visible = True Then c = c + 1
Next

For i = 2 To c

With WB.Worksheets("Sheet1")

SWB.Worksheets(i).Range(sadr).Copy

Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
End With

Sub Lock()
Dim ws As Worksheet
ws.Protect Password = "123", DrawingObjects:=False
End Sub

Sub UnLock_1()
ActiveSheet.Unprotect Password = "123"
End Sub

Sub Draft()
Dim C As Range

For Each C In Range("AM8:AN73")

If C.Formula Like "='\\*" Then
C.Copy

C.Offset(, 1).PasteSpecial Paste:=xlPasteFormulas
End If
Next
end sub

Sub Statment_prepare()
Sheets("Sheet1.").Range("AL74").End(xlToLeft).Offset(, -1).EntireColumn.Resize(, 2).Select 'выделяю два крайних левых столбца
Selection.Copy Destination:=Range("AL74").End(xlToLeft).Offset(, 2).EntireColumn 'вставляю выделнное с через один столбец
' до этого момента все работает, теперь начинается затык

Find("суммеслн").Select  'вот тут я хочу в выделенных крайних левых столбцах пройтись по всем ячейкам и заменить формулы вида "суммесли" на значения.

Dim End_date As String
Dim Start_date As String

Start_date = Range([A1]).Value
End_date = Range([B1]).Value
ActiveSheet.Range("$2:$100000").AutoFilter Field:=18, Operator:=xlFilterValues, Criteria1:=">=" & CLng("Start_date"), Operator:=xlAnd, Criteria2:="<=" & CLng("End_date")

Sub Link_paste()
Dim DestBook As String
Dim DR As String

DestBook = "book.xlsx" ' книга из которой берем ячейку
DR = "X63" ' ячейка на которую ссылаемся

On Error GoTo Errors1

Workbooks(DestBook).Activate
Worksheets(Index + 1).Activate 'вот это повторяется от 1 до 20 раз,
  Range(DR).Select
  Selection.Copy

Workbooks("Book2.xlsm").Activate 'рабочая книга куда вставляем линк
 
  Cells(Rows.Count, 2).End(xlUp).Offset(1).Select
  ActiveSheet.Paste link:=True

Workbooks(DestBook).Activate
Worksheets(Index + 2).Activate
  Range(DR).Select
  Selection.Copy

Workbooks("Book2.xlsm").Activate
 
  Cells(Rows.Count, 2).End(xlUp).Offset(1).Select
  ActiveSheet.Paste link:=True
  
  Workbooks(DestBook).Activate
Worksheets(Index + 3).Activate
  Range(DR).Select
  Selection.Copy

Workbooks("Book2.xlsm").Activate
 
  Cells(Rows.Count, 2).End(xlUp).Offset(1).Select
  ActiveSheet.Paste link:=True
  
Errors1:  MsgBox ("Достингут конец книги")

End Sub