如何用VBA仅复制Excel表格中已筛选的可见数据？

你的原代码会读取整个数据区域（包括筛选后隐藏的行），要让它只处理可见单元格，需要通过SpecialCells(xlCellTypeVisible)获取筛选后的可见行，同时保留你原有的非空判断逻辑。以下是修改后的代码：

Private Sub CommandButton1_Click()
    Dim i As Long, iR As Long
    Dim rngVisible As Range, rngRow As Range
    Dim arrRes()
    Dim oSht1 As Worksheet, oSht2 As Worksheet
    
    Set oSht1 = Sheets("COBA")
    Set oSht2 = Sheets("AMBIL")
    
    ' 清空目标工作表原有内容
    oSht2.Cells.Clear
    
    ' 获取筛选后的可见数据区域（排除表头行，从第2行开始）
    On Error Resume Next ' 防止没有可见行时报错
    Set rngVisible = oSht1.Range("A2").CurrentRegion.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' 如果没有可见数据，直接退出
    If rngVisible Is Nothing Then Exit Sub
    
    ' 初始化结果数组，按可见行数量分配空间
    ReDim arrRes(1 To rngVisible.Areas.Count * rngVisible.Rows.Count, 1 To 11)
    
    ' 遍历每一行可见数据
    For Each rngRow In rngVisible.Rows
        ' 保留原逻辑：第12列和第13列不为空才处理
        If Len(rngRow.Cells(1, 12).Value) * Len(rngRow.Cells(1, 13).Value) > 0 Then
            iR = iR + 1
            arrRes(iR, 4) = rngRow.Cells(1, 1).Value
            arrRes(iR, 5) = rngRow.Cells(1, 2).Value
            arrRes(iR, 6) = rngRow.Cells(1, 6).Value
            arrRes(iR, 7) = rngRow.Cells(1, 14).Value
            arrRes(iR, 8) = rngRow.Cells(1, 16).Value
            arrRes(iR, 9) = rngRow.Cells(1, 17).Value
            arrRes(iR, 10) = rngRow.Cells(1, 15).Value
        End If
    Next rngRow
    
    ' 将结果写入目标工作表
    If iR > 0 Then
        oSht2.Range("A1").Resize(iR, 11).Value = arrRes
    End If
End Sub

关键改动说明： #

• 获取可见区域：用SpecialCells(xlCellTypeVisible)筛选出筛选后显示的行，同时通过On Error处理没有可见行的情况，避免报错。
• 遍历可见行：直接遍历rngVisible.Rows，确保只处理筛选后显示的行，跳过隐藏行。
• 数组初始化优化：根据可见行的数量初始化结果数组，避免不必要的空间占用。
• 保留原业务逻辑：继续判断第12列和第13列是否非空，符合你原本的筛选需求。

内容的提问来源于stack exchange，提问作者little turtle