VBA - копировать только видимые ячейки с листа на другой лист

Question

У меня есть лист («Отформатированные данные») и лист («Данные клиента_1»)

Я запускаю макрос, который выполняет следующие шаги:

• выберите рабочий лист («Данные в формате Fromatted»)
• Данные автофильтра в столбце «C» со значением «client_1»
• копировать выбранные столбцы из листа («Отформатированные данные») и вставлять данные в лист («Данные клиента_1»)

В чем моя проблема:

• макрокоманда не только данных, которые я отфильтровал, но и всех их, даже если они не видны.

Мой код макроса:

Sub PRINT_AVIVA_ISA()

Sheets("Formatted Data").Select
ActiveSheet.Range("$A$1:$R$73").autofilter Field:=3, Criteria1:=Array( _
    "client_1"), Operator:=xlFilterValues

Dim LastRow As Long, erow As Long

LastRow = Worksheets("Formatted Data").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LastRow

Worksheets("Formatted Data").Cells(i, 2).Copy

        erow = Worksheets("Client_1 Data").Cells(Rows.Count, 1).End(xlUp).Row

        Worksheets("Formatted Data").Paste Destination:=Worksheets("Client_1 Data").Cells(erow + 1, 1) ' --- account number

        Worksheets("Formatted Data").Cells(i, 3).Copy

        Worksheets("Formatted Data").Paste Destination:=Worksheets("Client_1 Data").Cells(erow + 1, 2) ' --- designation

        Worksheets("Formatted Data").Cells(i, 4).Copy

        Worksheets("Formatted Data").Paste Destination:=Worksheets("Client_1 Data").Cells(erow + 1, 3) ' --- fund name

        Worksheets("Formatted Data").Cells(i, 5).Copy

        Worksheets("Formatted Data").Paste Destination:=Worksheets("Client_1 Data").Cells(erow + 1, 4) ' --- fund code

        Worksheets("Formatted Data").Cells(i, 7).Copy


    Next i
End Sub

Что мне нужно:

• вставьте в мой существующий код что-то , чтобы скопировать только отфильтрованные данные ?

Спасибо

Питер.

Answer 1

Проблема, с которой вы сталкиваетесь, заключается в том, что вы перебираете все ячейки в вашей таблице «отформатированных данных». Код VBA не проверяет, были ли отфильтрованы ячейки или нет.

Я прилагаю код ниже, который должен делать то, что вы пытаетесь сделать. Я внес несколько изменений, чтобы немного его очистить, например, сохранить листы в их собственной переменной, чтобы вам не приходилось ссылаться на них напрямую.

Кроме того, я решил использовать прямое присвоение значений, а не копировать / вставлять. Непосредственное присвоение значения обычно происходит быстрее и имеет более чистый, более информативный код. Компромисс в том, что он не копирует форматирование. Если вам действительно нужно форматирование, вы можете добавить его один раз (либо в начале, либо в конце процедуры, для всего столбца).

Узнайте, можете ли вы адаптировать приведенный ниже код, и дайте нам знать, если вам нужна дополнительная помощь.

Sub PRINT_AVIVA_ISA()
    Dim sData As Worksheet
    Dim sClient As Worksheet

    'Prevents the application from rendering graphical elements during processing
    Application.ScreenUpdating = False

    Set sData = Worksheets("Formatted Data")
    Set sClient = Worksheets("Client_1 Data")

    sData.Range("$A$1:$R$73").AutoFilter Field:=3, Criteria1:=Array( _
        "client_1"), Operator:=xlFilterValues

    LastRow = sData.Cells(Rows.Count, 1).End(xlUp).Row

    Dim i As Long

    For i = 2 To LastRow
        If sData.Rows(i).Hidden = False Then
            ' Rather than add 1 to erow 4 times later, just calculate it here
            erow = sClient.Cells(Rows.Count, 1).End(xlUp).Row + 1

            sClient.Cells(erow, 1).Value = sData.Cells(i, 2).Value
            sClient.Cells(erow, 2).Value = sData.Cells(i, 3).Value
            sClient.Cells(erow, 3).Value = sData.Cells(i, 1).Value
        End If
    Next i

    Application.ScreenUpdating = True

End Sub