Subscript out of range -в чем ошибка

[Bape}l{ka]

привет всем! ))

помогите разобраться, в чем ошибка?? при работе с несколькими книгами неадекватно реагирует на .Selection...
а если даже Selection заменяю цифрами, пишет "Subscript out of range" Т_Т
(excel 2003)

Private Sub CommandButton_Click()
    Dim Arr() As Integer, i As Integer    'динамич.массив
    Dim Opoznavatel As String, ColNo As Integer, BookName As String, SheetName As String
    Dim C As Range, firstAddress As String

    Opoznavatel = Checked 'TextBoxOpoznavatel.Value
    ColNo = 4 'Columns(TextBoxColNo.Value).Column
    BookName = TextBoxBookName.Value
    SheetName = TextBoxSheetName.Value
    
    'Очищаем массив
    i = 0
    ReDim Arr(i)
    
    MaxRow = 0
    
    'поиск значения, по которому будем определять № строки
    With ActiveWorkbook.ActiveSheet.UsedRange
        Set C = .Find(Opoznavatel, , xlValues, xlWhole)
        If Not C Is Nothing Then
            firstAddress = C.Address
            'MsgBox "firstAddress = " & C.Address
            Do
                C.Interior.ColorIndex = 33
                'переопред-е массива с сохр-ем данных
                ReDim Preserve Arr(i)
                Arr(i) = .Cells(C.Row, ColNo).Value
                i = i + 1
                MaxRow = MaxRow + 1
                Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> firstAddress
        Else
            MsgBox "Ничего не найдено"
            Exit Sub
        End If
    End With

    'Выводим массив Arr на нужный лист Excel указанной книги
    i = 0
    With Application.Workbooks(BookName).Worksheets(SheetName)
    FirstRow = .Selection.Row  'РУГАЕТСЯ
        For Roww = FirstRow To FirstRow + MaxRow
            .Cells(Roww, .Selection.Column).Value = Arr(i)  'ЛИБО РУГАЕТСЯ ТУТ, ЕСЛИ С ЦИФРАМИ
            i = i + 1
        Next Roww
    End With
     
End Sub

[VictorM]

В неактивной книге (листе) Selection не работает.
будет ругаться....

[Bape}l{ka]

оо, вот так получилось!!! только теперь почему то вместо массива у меня выводятся одни нули Т_Т

    'Выводим массив Arr на нужный лист Excel указанной книги
    i = 0
    Application.Workbooks(BookName).Worksheets(SheetName).Activate
    With ActiveWorkbook.ActiveSheet
    Colm = Selection.Column
    FirstRow = Selection.Row 
        
        For Roww = FirstRow To (FirstRow + MaxRow - 1)
            .Cells(Roww, Colm).Value = Arr(i)
            i = i + 1
        Next Roww
    End With
    MsgBox "Готово!"

вот файл OUTPUT.rar

[nerv]

Сообщение от Bape}l{ka

'Очищаем массив
i = 0
ReDim Arr(i)

Позвольте узнать, от чего вы очищаете Только что созданный массив?

Сообщение от Bape}l{ka

почему то вместо массива у меня выводятся одни нули Т_Т

Насколько мне известно, для вывода на лист, массив должен быть двухмерным, т.е.

ReDim Arr(1 to i, 1 to 1)

заполнять соответственно

 Arr(i,1) = .Cells(C.Row, ColNo).Value

вывод приблизительно так

[A1].Resize(i) =Arr()

[Bape}l{ka]

спасибо всем! ошибку нашла (чесно говоря, по-моему какой-то глюк, вобщем я просто переименовала одну переменную и все заработало =ь)

если кому нада, выкладываю.. макрос по определенному слову (и указанной колонке) собирает из разных таблиц данные в одну в указанную книгу
соответственно код формы:

Option Explicit
Option Compare Text

Private Sub CommandButton_Click()
    Dim Arr() As Double, i As Integer    'динамич.массив
    Dim iText As String, ColNo As Integer, BookName As String, SheetName As String
    Dim C As Range, firstAddress As String

    iText = TextBoxOpoznavatel.Value
    ColNo = Columns(TextBoxColNo.Value).Column
    BookName = TextBoxBookName.Value
    SheetName = TextBoxSheetName.Value
    
    'Очищаем массив
    i = 0
    ReDim Arr(i)
    
    MaxRow = 0
    
    'поиск значения, по которому будем определять № строки
    With ActiveWorkbook.ActiveSheet.UsedRange
        Set C = .Find(iText, , xlValues, xlWhole)
        If Not C Is Nothing Then
            firstAddress = C.Address
            'MsgBox "firstAddress = " & C.Address
            Do
                C.Interior.ColorIndex = 33
                'переопред-е массива с сохр-ем данных
                ReDim Preserve Arr(i)
                'MsgBox "C.Row = " & C.Row & ", ColNo = " & ColNo
                .Cells(C.Row, ColNo).Interior.ColorIndex = 38
                Arr(i) = .Cells(C.Row, ColNo).Value
                i = i + 1
                MaxRow = MaxRow + 1
                Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> firstAddress
        Else
            MsgBox "Ничего не найдено"
            Exit Sub
        End If
    End With

    'Выводим массив Arr на нужный лист Excel указанной книги
    i = 0
    Application.Workbooks(BookName).Worksheets(SheetName).Activate
    With ActiveWorkbook.ActiveSheet
    Colm = Selection.Column
    FirstRow = Selection.Row '.Selection.Row
        
        For Roww = FirstRow To (FirstRow + MaxRow - 1)
            .Cells(Roww, Colm).Value = Arr(i) '.Selection.Column
            i = i + 1
        Next Roww
    End With
    'задаем формат ячейки - числа десятичные
    Range(Cells(FirstRow, Colm), Cells(FirstRow + MaxRow - 1, Colm)).NumberFormat = "0.0"
    MsgBox "Готово!"
     
End Sub