Всем доброго времени суток.
Есть задача на одном листе "Общий" найти ячейку с заданным значением.
Выделить строку с найденной ячейкой.
Перенести её на лист "Буденновский".
Я далеко не силён в написании макросов. Сломал уже всё голову.
При запуске макрос отрабатывает один раз и останавливается. При повторном запуске, без закрытия книги, Excel зависает.
Есть задача на одном листе "Общий" найти ячейку с заданным значением.
Выделить строку с найденной ячейкой.
Перенести её на лист "Буденновский".
Я далеко не силён в написании макросов. Сломал уже всё голову.
При запуске макрос отрабатывает один раз и останавливается. При повторном запуске, без закрытия книги, Excel зависает.
| Код |
|---|
Sub Макрос1()
Dim a, b, c, e As Integer
Do ' Поиск пустой ячейки для вставки.
a = 3
If ThisWorkbook.Sheets("Буденновский").Cells(a, 1) > "" Then
a = a + 1
End If
Loop Until Cells(a, 1) = ""
' Поиск ячейки с заданным значением.
Set b = ThisWorkbook.Sheets("Общий").Range("G:G").Find(What:="Буденновский", _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
Do
' Получаем номер строки
c = Mid(b.Address, (InStr(2, b.Address, "$") + 1))
If Not b Is Nothing Then
Sheets("Общий").Activate
Range(Cells(c, 1), Cells(c, 7)).Cut
Sheets("Буденновский").Activate
Range(Cells(a, 1), Cells(a, 7)).Select
ActiveSheet.Paste
Set b = Range("G:G").FindNext(b)
End If
Loop While b Is Nothing
End Sub |
