Question

我目前正在使用此代码查找并删除具有特定条件的所有行...如何编辑它以将行移动到另一个工作表而不是删除它们？

  Sub Delete_Rows()
      Dim selectedValue As Integer

      myNum = Application.InputBox("Input Value")
      Dim rng As Range, cell As Range, del As Range
      Set rng = Intersect(Range("'potlife'!J2:J1500"), ActiveSheet.UsedRange)
      For Each cell In rng
      If (cell.value) = myNum _
      Then
      If del Is Nothing Then
      Set del = cell
      Else: Set del = Union(del, cell)
      End If
      End If
      Next cell
      On Error Resume Next
      del.EntireRow.Delete
   End Sub

Answer 1

我注意到的一件事是您定义了selectedValue，但似乎使用了myNum。您将希望在每个模块的顶部开始“Option Explicit”。例如，如果您没有声明myNum，这将强制您声明变量并给出编译错误。要在每个模块中自动插入“Option Explicit”，请单击工具＆gt;选项＆gt;编辑器＆gt;需要变量声明。

下面的代码会提供一个名为“复制行”的工作表，并将行复制到该工作表。请注意，它总是会将行复制到第2行，即使已存在某些内容：

Sub Copy_Rows()
Dim myNum As Long
Dim wsSource As Excel.Worksheet, wsTarget As Excel.Worksheet
Dim rng As Range, cell As Range, CellsToCopy As Range

Set wsSource = ThisWorkbook.Worksheets("potlife")
Set wsTarget = ThisWorkbook.Worksheets("copied rows")
myNum = Application.InputBox("Input Value")
On Error Resume Next
Set rng = Intersect(wsSource.Range("J2:J1500"), wsSource.UsedRange)
On Error GoTo 0
If rng Is Nothing Then
    Exit Sub
End If
For Each cell In rng
    If cell.Value = myNum Then
        If CellsToCopy Is Nothing Then
            Set CellsToCopy = cell
        Else
            Set CellsToCopy = Union(CellsToCopy, cell)
        End If
    End If
Next cell
On Error Resume Next
CellsToCopy.EntireRow.Copy Destination:=wsTarget.Range("A2")
End Sub

编辑excel 2003宏，删除复制

1 个答案: