powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Excel Find-Copy-Paste
2 сообщений из 2, страница 1 из 1
Excel Find-Copy-Paste
    #35432873
snursmursik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
ЗДравствуйте! Пользуюсь VBA в первый раз, потому что объем работы ну очень большой, надо автоматизировать, не получается... Задача такая: на 1ом листе первой книги во втором столбце сделать поиск по слову drilling, затем для каждой найденной ячейки скопировать всю строку содержащую ее и вставить в другой лист (другой книги или нет не принципиально). Вот мой код (ужас наверное, но 1й раз ведь..) работа очень срочная, плз помогите кто может
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
Dim lCount As Long
Dim rFoundCell As Range


Sheet("SD").Activate

Set rFoundCell = Range("B2")

For lCount =  1  To WorksheetFunction.CountIf(Columns( 2 ), "drilling")
Set rFoundCell = Columns( 2 ).Find(What:="drilling", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)

With rFoundCell
.Select.Row
.Selection.Copy
Windows("Book1").Activate
Columns("'lcount'").Select
ActiveSheet.Paste
Windows("SD").Activate
End With

Next lCount
End Sub
исходный лист называется SD
...
Рейтинг: 0 / 0
Excel Find-Copy-Paste
    #35437683
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
Option Explicit
Sub testCopy()
    Dim lCount As Long
    Dim rFoundCell As Range, tmpRng As Range, firstAddress As String
    Dim xlSh As Worksheet
    Set xlSh = Sheets("SD")
    With xlSh.Columns( 2 )
        Set rFoundCell = .Find("drilling", LookIn:=xlValues)
        If Not rFoundCell Is Nothing Then
            firstAddress = rFoundCell.Address
            Set tmpRng = rFoundCell
            Set rFoundCell = .FindNext(rFoundCell)
            Do While Not rFoundCell Is Nothing And rFoundCell.Address <> firstAddress
                Set tmpRng = Union(tmpRng, rFoundCell)
                Set rFoundCell = .FindNext(rFoundCell)
            Loop
            tmpRng.EntireRow.Copy
            Windows("Книга2").Activate 'Windows("Book1").Activate
'            Columns("'lcount'").Select
            ActiveSheet.Paste
'            Windows("SD").Activate
        End If
    End With
End Sub
...
Рейтинг: 0 / 0
2 сообщений из 2, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Excel Find-Copy-Paste
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]