Searching three hyperlinks and outputting each on a new sheet - vba

Question

Looking in the Column "U" unit ( 1 ) and the opposite of that cell in the Column "E" extracting hyperlink, then paste it on a new sheet (and so each unit)
I wrote a program , but it does not give needed result .
Sub подготовительная()
Dim r As Range
Dim rng As Range
Dim book1 As Workbook
Dim str As String
Dim gbr As Range
Set book1 = Workbooks.Open("E:\...\Вопрос.xlsx")
'переходим в активную книгу на 1-ую страницу и выделяем диапозон
book1.Worksheets("7").Activate
Set rng = book1.Worksheets("7").Range("U33:U99")
'находим первую 1
Set r = rng.Find(What:="1")
'запоминаем 1-ый адресс
firstAddress = r.Address
'другая переменная
Set gbr = r.Offset(, -16)
'забираем гиперссылку
str = gbr.Hyperlinks.Item(1).Address
'вставляем в Лист1
book1.Worksheets("Лист1").Cells(1, 1).Value = str
'ищем вторую 1
book1.Worksheets("7").Activate
Set r = r.FindNext(r)
If r.Address <> firstAddress Then
Set gbr = r.Offset(, -16)
str = gbr.Hyperlinks.Item(1).Address
book1.Worksheets("Лист2").Cells(1, 1).Value = str
Else: Exit Sub
End If
'ищем третью 1
book1.Worksheets("7").Activate
Set r = r.FindNext(r)
If r.Address <> firstAddress Then
Set gbr = r.Offset(, -16)
str = gbr.Hyperlinks.Item(1).Address
book1.Worksheets("Лист3").Cells(1, 1).Value = str
Else: Exit Sub
End If
End Sub

Answer 1

I think your mistakes is in:
Set r = r.FindNext(r)
where you're trying to find the next occurrence if "1" in range r instead of rng
so you should use
Set r = rng.FindNext(r)
Furthermore you may want to shorten your code down with the use of a loop, a string array (where to store your three sheets names: "Лист1", "Лист2" and "Лист3") and some With statements, like follows:
Option Explicit
Sub main()
Dim r As Range
Dim firstAddress As String
Dim iLoop As Long
Dim sheetNames(1 To 3) As String
sheetNames(1) = "Лист1" '<--| change it with your actual 1st sheet name
sheetNames(2) = "Лист2" '<--| change it with your actual 2nd sheet name
sheetNames(3) = "Лист3" '<--| change it with your actual 3rd sheet name
With Workbooks.Open(E:\...\Вопрос.xlsx").Worksheets("7").Range("U33:U99") '<--| open wanted workbook and refer to cells "U33:U99" in its worksheet "7"
Set r = .Find(What:="1") '<--| the Find() method is called on the range referred to in the preceding With statement
If Not r Is Nothing Then
firstAddress = r.Address
Do
iLoop = iLoop + 1 '<-- update loop counter
.Parent.Parent.Worksheets(sheetNames(iLoop)).Cells(1, 1).value = r.Offset(, -16).Hyperlinks.item(1).Address '<--| write into proper worksheet whose name is taken from sheetNames array at index corresponding to current loop
Set r = .FindNext(r) '<--| the FindNext() method is still called on the same range as in the preceding .Find() statement
Loop While Not r Is Nothing And r.Address <> firstAddress And iLoop < 3 '<--| exit loop if either you hit the first link or completed three loops
End If
End With
End Sub