Question

我有一个筛选后的工作表（ActionRegister），我只想将筛选后的（可见）单元格复制到同一工作簿中名为Duplicate的新工作表中。实际数据从第4行开始（以上是标题），并且行数可变，但始终是A：Q列。

我没有使用VBA的经验，并且确实在努力寻找解决方案。我已经看到了用于复制到新工作簿等的代码，但是我的背景非常有限，我什至不能出于自己的目的对其进行修改。

有人可以提供仅复制可见/已过滤单元格而忽略行数可变的标头的代码吗？谢谢！！：）

Answer 1

尝试下面的一项。

Sub cpVisible()
Dim MyProdName As String
Dim FilteredRange As Range
Dim myArr As Variant

    Sheets("ActionRegister").Range("$A$4:$Q$50000").AutoFilter Field:=2, Criteria1:="IT"
    Set FilteredRange = Sheets("ActionRegister").Range("$A$4:$Q$50000").SpecialCells(xlCellTypeVisible)
    FilteredRange.Copy Sheets("Duplicate").Range("A1")

End Sub

如果要根据条件过滤数据，则需要更改条件(Criteria1:="IT")和列号(Field:=2)。

Answer 2

也许这段代码将为您完成：

Option Explicit

Public Sub Copy_Columns()


    Dim r As Range
    Dim r2 As Range
    Dim lLast_Row1 As Long
    Dim lLast_Row2 As Long
     'identify the columns and copy the data
    With Worksheets("Raw").ListObjects(1).DataBodyRange
        Set r = Application.Union(.Columns(1), .Columns(2), .Columns(7)).SpecialCells(xlCellTypeVisible)
    End With
    With Worksheets("Output")
        Set r2 = .Range("B8:D8").Resize(.Range("B6").CurrentRegion.Rows.Count)

        r2.Clear
        r.Copy r2.Cells(1, 1).Offset(-1)

         'extend the formulas
        lLast_Row1 = .Range("E" & Rows.Count).End(xlUp).Row
        lLast_Row2 = .Range("B" & Rows.Count).End(xlUp).Row

        If lLast_Row2 > lLast_Row1 Then
            .Range("E" & lLast_Row1).Resize((lLast_Row2 - lLast_Row1) + 1, 6).FillDown
        End If         
    End With     
End Sub

Answer 3

sub makeDuplicate()

    application.displayalerts = false
    on error resume next
    worksheets("Duplicate").delete
    on error goto 0
    application.displayalerts = true

    dim target as range

    with worksheets.add(after:=worksheets("ActionRegister"))
        .name = "Duplicate"
        set target = .cells(1)
    end with

    with worksheets("ActionRegister")

        intersect(.range("A:Q"), .usedrange.offset(3, 0), .usedrange).SpecialCells(xlCellTypeVisible).copy _
          destination:=target

    end with

end sub

将行数可变的已过滤数据复制到新工作表中

3 个答案: