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

私が気づいたことの1つは、あなたが定義selectedValueしたが、使用しているように見えたことmyNumです。すべてのモジュールの先頭に「Option Explicit」を配置することをお勧めします。myNumこれにより、変数を宣言することが強制され、たとえば を宣言しないとコンパイル エラーが発生します。すべてのモジュールに「Option Explicit」を自動的に挿入するには、[ツール] > [オプション] > [エディタ] > [変数宣言が必要] をクリックします。

以下のコードは、「コピーされた行」という名前のワークシートを想定しており、行をそれにコピーします。すでに何かがある場合でも、常に行を行 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 に答える