用VBA符合条件的数据复制到另一个工作表中

要求：表2中J列为条件，符合条件的行全部复制到表1中

不解释，直接上两段代码，SHEET2中第十列，也就是J列中，符合条件的，复制行到表1中。

Sub xx()

    On Error Resume Next

    Dim x As Long

    x = Sheets("newsheet").Range("a65536").End(xlUp).Row() + 1

    For i = 1 To Sheet1.Range("a65536").End(xlUp).Row()

        If Sheet1.Cells(i, "J") = 1 Then

            Sheet2.Rows(i).Copy

            Sheet1.Select

            Rows(x).Select

            ActiveSheet.Paste

            x = x + 1

        End If

    Next i

End Sub

以上代码，表2中J列的条件是：1

Sub 筛选()

    Dim i, n, arr, brr, a#

    arr = [a1].CurrentRegion

    a = InputBox("请输入筛选的数字", "数字")

    ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))

    For i = 2 To UBound(arr)

        If arr(i, 10) = a Then

            n = n + 1

            For j = 1 To UBound(arr, 2)

                brr(n, j) = arr(i, j)

            Next

        End If

    Next

    Sheet1.[a2].Resize(UBound(brr), UBound(brr, 2)) = brr

    MsgBox "OK"

End Sub

以上代码，查找表2中第十列中等于你输入的复制到表1中

好吧，结束了才晓得，只能输入数字，不能汉字，下面是折腾汉字，还没测试

Sub 筛选()

    Dim i, n, arr, brr

    arr = [a1].CurrentRegion

    a = InputBox("请输入筛选的关键词", "关键词")

    ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))

    For i = 2 To UBound(arr)

        If arr(i, 10) = a Then

            n = n + 1

            For j = 1 To UBound(arr, 2)

                brr(n, j) = arr(i, j)

            Next

        End If

    Next

    Sheet1.[a2].Resize(UBound(brr), UBound(brr, 2)) = brr

    MsgBox "OK"

End Sub