Добрый вечер всем,
Есть Лист-опросник (Да/нет)
Лист, куда необходимо по кнопке на нем скопировать все строки с листа-опросника, ответ на которые составляет "Да"
Друг за другом, начиная с первой пустой строки после шапки
Посмотрите код, плз - где-то ошибка( выдает ошибку в строке " b(r,1) = a(i, 1), пишет b(r,1) out of range)
Код |
---|
Блок стилей "STYLE"
Sub Rectangle2_Click()
Dim a() As Variant, b() As Variant, c() As Variant, i As Long, r As Long, iLastRow1 As Long, iLastRow2 As Long, nRow1 As Long, nRow2 As Long
nRow1 = 6 'строка начала данных на листе Risk Taxonomy
nRow2 = 6 'строка начала данных на листе Risk Identification
iLastRow1 = ActiveWorkbook.Sheets("Risk Taxonomy").Cells(Rows.Count, "B").End(xlUp).Row 'поиск номера последней незаполненной ячейки
iLastRow2 = ActiveWorkbook.Sheets("Risk Identification").Cells(Rows.Count, "B").End(xlUp).Row
a = ActiveWorkbook.Sheets("Risk Taxonomy").Range("B" & nRow1 & ":N" & iLastRow1).Value
ActiveWorkbook.Sheets("Risk Identification").Range("B" & nRow2 & ":N400" & iLastRow2).Value = ""
b = ActiveWorkbook.Sheets("Risk Identification").Range("B" & nRow2 & ":N" & iLastRow2).Value
r = 1
For i = 1 To iLastRow1 - nRow1
If a(i, 13) = "Yes" Then
b(r, 1) = a(i, 1)
b(r, 2) = a(i, 2)
b(r, 3) = a(i, 3)
r = r + 1
End If
Next i
ActiveWorkbook.Sheets("Risk Identification").Range("B" & nRow2 & ":F" & iLastRow2).Value = b
ActiveWorkbook.Sheets("Risk Identification").Range("B" & nRow2 & ":F" & iLastRow2).Select
Selection.Borders.LineStyle = xlContinuous
End Sub
|