excel - 从过滤的数据中复制行并插入到现有数据中

Question

我正在尝试复制数据行(可能会或可能不会被过滤)并将其插入到现有数据上方的行中(类似于滚动计划)。下面是我适用于未过滤数据的代码。如果我对要复制的数据应用任何过滤器，我的宏将只复制 1 个单元格。谁能提供一个可以复制过滤和未过滤数据的宏示例？

Sub DynamicRange()
'Best used when first column has value on last row and first row has a value in the last column

Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Dim SelectedRange As Range

Set sht = ActiveWorkbook.ActiveSheet
Set StartCell = Range("C9")

If IsEmpty(StartCell.Value) = True Then
  MsgBox "Enter Dates to export"
  Exit Sub
End If

'Find Last Row and Column
  LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
  LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column

'Select Range and Copy
  Set SelectedRange = sht.Range(StartCell, sht.Cells(LastRow, LastColumn))
  SelectedRange.Select
  Selection.SpecialCells(xlCellTypeVisible).Select
  Selection.Copy

'Select sheet "TRACKER" insert values above previous data
Sheets("TRACKER").Select
Range("B9").Select
Selection.Insert Shift:=xlDown

'clear selection
Application.CutCopyMode = False

End Sub

Answer 1

我已经重写了你的子程序并试图避免使用 .Select和 Selection .依靠 ActiveCell¹ 等属性和 ActiveSheet¹充其量是偶然的。

Sub DynamicRange()
    Dim sc As Range, sht As Worksheet

    Set sht = ActiveWorkbook.Worksheets("Sheet1")  '<~~ set this worksheet reference properly
    'btw, if you really needed ActiveWorkbook here then you would need it with Worksheets("TRACKER") below.

    With sht
        Set sc = .Range("C9")   'don't really have a use for this
        If IsEmpty(.Range("C9")) Then
          MsgBox "Enter Dates to export"
          Exit Sub
        End If
        With .Range(.Cells(9, 3), .Cells(9, Columns.Count).End(xlToLeft))
            With Range(.Cells(1, 1), .Cells(Rows.Count, .Columns.Count).End(xlUp))
                'got the range; determine non-destructively if anything is there
                If CBool(Application.Subtotal(103, .Cells)) Then
                    'there are visible values in the cells
                    .Cells.Copy _
                      Destination:=Worksheets("TRACKER").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
                End If
            End With
        End With
    End With

End Sub

工作表的 SUBTOTAL function不计算隐藏值，所以它是一个很好的非破坏性测试可见值的存在。您不需要复制 Range.SpecialCells与 xlCellTypeVisible property具体来说。一个普通的 Range.Copy method只会复制可见单元格。通过立即指定目的地，无需将 ActiveSheet 属性转移到 追踪器 工作表；只需要指定目的地的左上角。

¹ 见 How to avoid using Select in Excel VBA macros了解更多摆脱依赖选择和激活来实现目标的方法。