Макрос Excel удаляет нужные ячейки

[Merlicka]

Добрый день, друзья. Нужна помощь в исправлении макроса. Макрос копирует из листа 1 на лист 2 столбцы A,B,C при условии, если заполнен столбец A. Однако, если попробовать написать на листе 2 что-нибудь в столбцах D, E, F и тд, и перейти со 2 листа на 1, то он стирает все, что было написано на 2 листе. Как можно исправить макрос, чтобы он копировал нужные ячейки на лист 2 и не стирал с него всё остальное?

Код: (vb)

Private Sub Worksheet_Activate()
    Dim a(), i&, ii&, x&
    a = Sheets(1).UsedRange.Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 1))
    For i = 1 To UBound(a)
        If Len(a(i, 1)) Then
            ii = ii + 1
                b(ii, 1) = a(i, 1) 'столбец A
                b(ii, 2) = a(i, 2) 'столбец B
                b(ii, 3) = a(i, 3) 'столбец C
        End If
    Next
    [a1].Resize(ii, UBound(b, 1)) = b
End Sub

[vikttur]

Владелец этого сайта отвечает вам в Вашей теме. Зачем по сети пошли гулять? А если уж пошли, то нужно самостоятельно давать ссылки на обсуждение вопроса.

[Федя Пробкин]

Ошибка в определении размерностей массива. Я исправил вроде работает

Код: (vb)

Private Sub Worksheet_Activate()
    Dim a(), i&, ii&, x&
    a = Sheets(1).UsedRange.Value
    ReDim b(1 To UBound(a, 2), 1 To UBound(a, 1))
    For i = 1 To UBound(a, 2)
        If Len(a(i, 1)) Then
            ii = ii + 1
                b(ii, 1) = a(i, 1) 'ñòîëáåö A
                b(ii, 2) = a(i, 2) 'ñòîëáåö B
                b(ii, 3) = a(i, 3) 'ñòîëáåö C
        End If
    Next
    [a1].Resize(ii, UBound(b, 1)) = b
End Sub