0

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

  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
4

1 回答 1

0

我注意到的一件事是您定义selectedValue但后来似乎使用myNum. 您将希望在每个模块的顶部开始使用“Option Explicit”。例如,这将强制您声明变量并在您不声明时给您一个编译错误myNum。要在每个模块中自动插入“选项显式”,请单击工具>选项>编辑器>需要变量声明。

下面的代码假定一个名为“复制行”的工作表并将行复制到它。请注意,它将始终将行复制到第 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
于 2013-05-20T14:02:35.603 回答