Вообще-то эти строки с введением последней заполненной (вернее первой пустой ячейки в первом столбце) можно заменить на
1.
2.
3.
4.
5.
6.
For i = 1 To 20
If Cells(i, 24 ).Text = 1 Then
Rows(i).Copy Target_.Cells(iLastRow, 1 )
iLastRow = Cells(Target_.Rows.Count, 1 ).End(xlUp).Row + 1
End If
Next i
Ну а целиком весь код будет таким:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
Option Explicit
Sub CopyData()
Dim wb As Workbook
Dim obr As Boolean ' is open "обработка макросом.xlsx"
Dim ObrMa As Workbook ' будет обработка макросом.xlsx Workbook
Dim iLastRow As Long
Dim Target_ As Worksheet, sh As Worksheet
Dim i As Integer
Set sh = ActiveSheet
For Each wb In Workbooks
If wb.Name = "обработка макросом.xlsx" Then obr = True: Set ObrMa = wb: Exit For
Next
If obr = False Then Set ObrMa = Workbooks.Open(ThisWorkbook.Path & "\" & "обработка макросом.xlsx", ReadOnly:=False)
Set Target_ = ObrMa.Sheets( 1 )
iLastRow = Target_.Cells(Target_.Rows.Count, 1 ).End(xlUp).Row + 1
For i = 1 To 20
If sh.Cells(i, 24 ).Text = 1 Then
sh.Rows(i).Copy Target_.Cells(iLastRow, 1 )
iLastRow = Target_.Cells(Target_.Rows.Count, 1 ).End(xlUp).Row + 1
End If
Next i
End Sub
Рассчитано, что обработка макросом.xlsx уже открыт, а если неоткрыт, он откроется, если лежит рядом с файлом с этим кодом. Правда, если там такого файла нет, то будет ошибка.
Код запускать при активном листе, откуда надо копировать.
Код в работе проверил на xls в 2000. Единственное - чистый лист заполняет со 2-ой ячейки. Если надо непременно с 1-ой, тогда до цикла задать iLastRow = 1. Но тогда всегда первую строку всегда будет копировать в первую строку, а остальные в первую пустую.
Можно вот это
1.
iLastRow = Target_.Cells(Target_.Rows.Count, 1 ).End(xlUp).Row + 1
определять непосредственно перед копированием, но тогда скопировать в первую строку листа уже никак не получится.
