With Worksheets(1).Range("a1:a500")
    Set c = .Find(2, lookin:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Value = 5
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

With Worksheets(1).Range("a1:a500") 'обращаемся к столбцу а с 1 по 500 ячейку на листе1
    Set c = .Find(2, lookin:=xlValues) 'устанавливаем переменную для поиска и  ищем ее. если я правильно понимаю цифру два заменяем своим значением?
    If Not c Is Nothing Then   'если это значение находим
        firstAddress = c.Address 'то запоминаем его адрес и здесь я могу вставить свой код?
        Do    
            c.Value = 5   ' после выполнения предыдущей команды и в случае если первое значение не нашли задаем новое значение для поиска?
           
'вот дальше не понятно опять устанавливаем значение для поиска и ищем его  и с чем сравнивается первый адрес?
Set c = .FindNext(c)       
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

Do    
            c.Value = 5   ' все искомые значения по ячейкам заменяются на цифру 5
            Set c = .FindNext(c)       
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

With Range("a1:a500")
    Set c = .Find("Раздел01", LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Range(Range("a1:a2000").Find("раздел01", , xlValues, xlWhole).Address, Range("a1:a2000").Find("раздел*", , xlValues, xlWhole).Address).Copy Range("D9:D999")

Private Sub CommandButton1_Click()
    Dim c1 As Range, c2 As Range

    With Range("a1:a500")
        For i = 1 To 4
            Set c1 = .Find("раздел0" & i, LookIn:=xlValues)
            If Not c1 Is Nothing Then
                Set c2 = .Find("раздел0" & i + 1, LookIn:=xlValues)
                If Not c2 Is Nothing Then
                    Range(c1.Address, c2.Address).Copy Cells(9, i + 3)

                End If
            End If
        Next
    End With

End Sub

Sub tt()
    Dim i&, t$, el

    With CreateObject("Scripting.Dictionary")
        For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
            If Len(Cells(i, 1)) Then
                If InStr(Cells(i, 1), "раздел") Then
                    t = Cells(i, 1)
                Else
                    If Not .exists(t) Then .Add t, New Collection
                    .Item(t).Add Cells(i, 1).Value
                End If
            End If
        Next

        For Each el In .keys
            For Each col In .Item(el)
                MsgBox el & " = " & col
            Next
        Next
    End With

End Sub

Dim c1 As Range, c2 As Range 'задаем переменные куда будем копировать найденные адреса
    With Range("a1:a500") ' задаем область поиска, в данном случае столбец A
        For i = 1 To 2 ' запускаем цикл для перебора всех значение от одного
        'до конечного значения, которое должно быть меньше на 1 количества разделов
            Set c1 = .Find("раздел0" & i, LookIn:=xlValues) 'ищем первое значение
            If Not c1 Is Nothing Then  'если первое значение найдено, то переходим к поиску второго значения
                Set c2 = .Find("раздел0" & i + 1, LookIn:=xlValues) 'ищем второе значение, со следующей
                'строки, для этого увеличиваем на один адрес строчки первого значения
                If Not c2 Is Nothing Then 'если второе значение найдено, то переходим к копированию диапазона
                    Range(c1.Address, c2.Address).Copy Cells(9, i + 3) 'копируем область между с1 и с2 в ячейку 9 4 столба
                End If
            End If
        Next
    End With
End Sub

Private Sub CommandButton2_Click()

Range("B1") = "ромашка"
Range("B2") = Range("E1")
Dim i, i1, lLastRow As Long
  For i = 1 To 40  'задаем диапазон поиска в столбце
    If Range("e" & i) = "ромашка" Then   'ищем ячейку со своим значением
    'MsgBox Range("e" & i).Address
    lLastRow = Cells(Rows.Count, 2).End(xlUp).Row  'определяем строку полседней зянятой ячейки в столбце 13
    Range("e" & i).CurrentRegion.Copy Range("B" & lLastRow + 2) 'копируем диапазон заполненых ячеек вниз и право от заданной ячейки в столбец он же 13
    End If
  Next
  
  lLastRow = Cells(Rows.Count, 2).End(xlUp).Row
  Range("B" & lLastRow + 2) = Range("g1")
For i1 = 1 To 40  'задаем диапазон поиска в столбце
    
    If Range("g" & i1) = "ромашка" Then   'ищем ячейку со своим значением
    'MsgBox Range("e" & i).Address
    lLastRow = Cells(Rows.Count, 2).End(xlUp).Row  'определяем строку полседней зянятой ячейки в столбце 13
    Range("g" & i1).CurrentRegion.Copy Range("B" & lLastRow + 2) 'копируем диапазон заполненых ячеек вниз и право от заданной ячейки в столбец он же 13
    End If
  Next
  
  lLastRow = Cells(Rows.Count, 2).End(xlUp).Row
  Range("B" & lLastRow + 2) = "ВАСЕЛЬКИ"
  Range("B" & lLastRow + 4) = Range("E1")
   
  
End Sub

Dim c1 As Range, c2 As Range 'задаем переменные куда будем копировать найденные адреса
Dim i, i1 As Integer
    With Range("a1:a500") ' задаем область поиска, в данном случае столбец A
    For i = 1 To 100  'задаем диапазон поиска в столбце
    If Range("a" & i) = "ромашка" Then   'ищем ячейку со своим значением
    Set c1 = Range("a" & i) 'запоминаем найденную ячейку
    For i1 = 1 To 6 'задаем диапазон поиска в столбце
    If Len(Cells(c1.Row + i1, 1)) Then 'проверяем ячейки на содержание записей
    'MsgBox Cells(c1.Row + i1, 1).Address
    Else
    Set c2 = Cells(c1.Row + i1, 1) 'запоминаем пустую ячейку
   ' MsgBox "пусто" & Cells(c1.Row + i1, 1).Address
    lLastRow = Cells(Rows.Count, 4).End(xlUp).Row 'определяем строку последней занятой ячейки в столбце
    Range(c1.Address, c2.Address).Copy Range("d" & lLastRow + 2) 'копируем область между с1 и с2 в последнюю занятую ячейку столбца D
    Exit For 'Выходим из цикла если найдена пустай ячейка
    End If 'Выходим из условия по проверки занятой ячейки
    Next 'если пустая ячейка не найдена продолжаем цикл
    End If 'Выходим из поиска если искомого значения
    Next 'продолжаем поиск искомого значения
    End With
End Sub

        For Each el In .keys 'перебор ключей, как перейдёте на следующий - можно поменять столбец или что угодно
            For Each col In .Item(el)'перебор содержимого собранной коллекции для каждого ключа, как перейдёте на следующий - можно поменять например строку, или что угодно
                MsgBox el & " = " & col
            Next
        Next