程序代码：

Sub tn()
        Dim k, i, m As Long
        Dim max_row As Long
         
        With Sheet1
                max_row = .[a:c].Find("*", , xlValues, , , xlPrevious).Row
                Sheet3.Rows.Clear
                For i = 2 To max_row
                        If .Rows(i).Hidden = False Then
                                Sheet3.Cells(m + 1, 1) = .Cells(i, 1)
                                For k = 6 To 13
                                        Sheet3.Cells(m + 1, k - 4) = .Cells(i, k)
                                Next
                                m = m + 1
                        End If
                Next
        End With
End Sub

筛选后，部分数据粘贴到另个表中.rar (28.39 KB)

[此贴子已经被作者于2019-9-20 09:54编辑过]

[此贴子已经被作者于2019-9-20 09:55编辑过]