Question

我有工作表（“格式化数据”）和工作表（“ Client_1数据”）

我运行宏，该宏执行以下步骤：

选择工作表（“ Fromatted数据”）
“ C”列中的值为“ client_1”的自动过滤数据
从工作表中复制选定的列（“格式化数据”），然后将数据粘贴到工作表中（“ Client_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

VBA-仅将工作表中的可见单元格复制到另一个工作表

1 个答案: