Vba 从筛选的数据中选择有限的数据行

我在Excel工作表中有70000行数据。应用筛选器后，可见行的总数将变为40000。现在我只想选择并复制前15000个可见行。

这应该适合您。我建议将其设置为在键盘快捷键上运行

Const limit As Integer = 15000 

Sub GrabFiltered()
    Dim r As Range
    Dim lr As Range
    Dim tr As Range
    Dim rr As Range
    Dim br As Range
    Dim table As Range
    Dim rows As Integer
    Dim i As Integer
    Dim ct As Integer
    Dim offset As Integer

    Set r = Selection.Cells(1, 1)
    If r.End(xlToLeft).Cells(1, 1).FormulaR1C1 <> "" Then
        Set lr = r.End(xlToLeft).Cells(1, 1)
    Else
        Set lr = r
    End If
    If lr.End(xlUp).Cells(1, 1).FormulaR1C1 <> "" Then
        Set tr = lr.End(xlUp).Cells(1, 1)
    Else
        Set tr = lr
    End If
    If r.End(xlToRight).Cells(1, 1).FormulaR1C1 <> "" Then
        Set rr = r.End(xlToRight).Cells(1, 1)
    Else
        Set rr = r
    End If
    rr.Select
    If rr.End(xlDown).Cells(1, 1).FormulaR1C1 <> "" Then
        Set br = rr.End(xlDown).Cells(1, 1)
    Else
        Set br = r
    End If

    Set table = Range(tr, br)

    'count the number of rows that are visible
    rows = 0
    For i = 1 To table.rows.Count
        If table.Cells(i, 1).Height <> 0 Then
            rows = rows + 1
        End If
    Next

    'limit the number of rows to copy
    If rows > limit Then
        offset = rows - limit
        i = 1
        ct = 1
        While i <> offset
            If br.offset(-ct, 0).Height <> 0 Then
                i = i + 1
            End If
            ct = ct + 1
        Wend
        Set br = br.offset(-ct, 0)
        Set table = Range(tr, br)
    End If

    table.Copy
End Sub

---

为了清晰起见，您确实需要编辑此问题。感谢您以简单的方式快速回答-我只想从过滤数据中复制前15000行。简单地说-我只想从过滤数据中复制前15000行可见*行。我相信类似Range.SpecialCellsXLTypeVisible.copy的内容就是您想要的。遵循@MatthewD的建议并粘贴到新工作表，删除15000后的行。谢谢。由于这对您有效，请单击答案旁边的复选标记。这向社区表明，您认为答案是可以接受的，并给您和我额外的声誉分数。