Добрый вечер всем,
Есть Лист-опросник (Да/нет)
Лист, куда необходимо по кнопке на нем скопировать все строки с листа-опросника, ответ на которые составляет "Да"
Друг за другом, начиная с первой пустой строки после шапки
Посмотрите код, плз - где-то ошибка( выдает ошибку в строке " b(r,1) = a(i, 1), пишет b(r,1) out of range)
Есть Лист-опросник (Да/нет)
Лист, куда необходимо по кнопке на нем скопировать все строки с листа-опросника, ответ на которые составляет "Да"
Друг за другом, начиная с первой пустой строки после шапки
Посмотрите код, плз - где-то ошибка( выдает ошибку в строке " 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 |