筛选某列数据并复制筛选结果

penpalfriend

我要将发函大表里面C列标“√”的数据，单独生成一张发函清单。
发函大表是这样的：
C:\Users\qu.yi\Desktop\发函大表.png
想要生成的结果是这样的（这里用筛选代替）：
C:\Users\qu.yi\Desktop\发函清单.png
但是我写的代码运行之后目前只能复制表头，大佬们求助。

penpalfriend

怎么发图片。。

liulang0808

Sub 生成发函清单()

Worksheets.Add after:=Worksheets("发函大表") '在"发函大表"的后面生成sheet页

ActiveSheet.Name = "发函清单1"   '给当前生成的sheet页命名为"发函清单"

Sheets("发函大表").Rows(1).Copy Sheets("发函清单1").Range("A1") '将"发函大表"表头复制到"发函清单"

Dim arr(1 To 2000, 1 To 30) '定义数组
Worksheets("发函大表").Select

rw = Cells(Rows.Count, "c").End(xlUp).Row 'rw为C列最后一个非空单元格的行数
rn = Range("A2:Z" & rw) '声明rn范围

For i = 1 To UBound(rn) '上限是rn的行数

    If InStr(1, rn(i, 3), "√") = 0 Then
        a = a + 1
        For j = 1 To UBound(rn, 2) '上限是rn的列数
            arr(a, j) = rn(i, j)
        Next
    End If
Next
With Sheets("发函清单1")
    .Range("A2").Resize(a, 26) = arr
End With


End Sub

liulang0808

其他的做雷同需改吧

penpalfriend

liulang0808 发表于 2020-1-21 18:46
Sub 生成发函清单()

Worksheets.Add after:=Worksheets("发函大表") '在"发函大表"的后面生成sheet页
...

多谢！！！
所以我的问题是因为生成新的sheet之后把activesheet选到了新生成的sheet，下面的代码等于在新的sheet里运行了是吗？