Question

道歉编辑。我有下面的代码，它将一行的数据从1张复制到另一张（中间有空格）。代码工作正常，但我希望它只复制工作表1中的可见字段（已应用过滤器）。

这是复制整个列U而不管应用的过滤器（过滤器应用于第10栏和第38栏）

With Worksheets("Sheet1")

Set SrcRng = .Range(.Cells(1, "U"), .Cells(.Rows.Count, "U").End(xlUp))
End With
Worksheets("Sheet2").range("I1").Resize(SrcRng.Rows.Count, 1).Value = SrcRng.Value'

请帮忙

Answer 1

尝试：

Sub CopyVisible()
Dim ws As Worksheet, ws2 As Worksheet
Dim SrcRange As Range, CpyRng As Range
Dim LRow As Long

Set ws = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

If ws.AutoFilterMode Then ws.AutoFilter.ShowAllData 'Removes Previous Filters

With ws
    LRow = .Cells(.Rows.Count, 8).End(xlUp).Row 'Check Col "H" for last data
    Set SrcRng = .Range(.Cells(1, 1), .Cells(LRow, 39)) 'Range with Data
        With SrcRng
            .AutoFilter Field:=39, Criteria1:="Blue"
            .AutoFilter Field:=8, Criteria1:="Pass"
            .AutoFilter Field:=10, Criteria1:="<>"
        End With
    For i = 1 To LRow 'Loop through all Rows
        If Not .Cells(i, 1).EntireRow.Hidden Then 'Checks if Row is Hidden
            If CpyRng Is Nothing Then
                Set CpyRng = .Range("U" & i)
            Else
                Set CpyRng = Union(CpyRng, .Range("U" & i))
            End If
        End If
    Next i
End With
ws.AutoFilter.ShowAllData 'Remove Filters
CpyRng.Copy ws2.Range("I1") 'Copy and Paste
End Sub

将过滤器应用于1到39之间的所有列，并使用所需标准进行过滤。在Col U中创建包含所有可见行的范围，并将其粘贴到Sheet2到Col I。

仅从一张纸张复制到另一张纸张（中间有空白）

1 个答案: