Excel VBA選択せずにシート間でコピーする

Question

いくつかのセルの内容に基づいて、選択した範囲のみを1つのシートから別のシートにコピーしようとしています。私が開発したコードは、実際に情報をコピー＆ペーストしようとするまで動作します。私は同様のコードを持つ多くのサイトを見直しましたが、違いは私がある範囲に実行しようとしていることです。

私は次のエラーを取得する：実行時エラー「1004」：Appliction - 次のように定義またはオブジェクト定義エラー

は私のコードは次のとおりです。

Option Explicit 
    Sub CopyRed() 

    Dim ws1 As Worksheet 
    Dim ws2 As Worksheet 
    Dim LastRow1 As Integer 
    Dim LastRow2 As Integer 
    Dim check As Integer 
    Dim Cond1 As String 
    Dim Cond2 As String 
    Dim Cond3 As String 
    Dim i as Integer 

    Set ws1 = Sheets(1) 
    Set ws2 = Sheets(2) 

    'set search criteria 
    'define # rows in tool tracker 
    Cond1 = ws1.Cells(1, 4) 
    Cond2 = ws1.Cells(2, 4) 
    Cond3 = ws1.Cells(3, 4) 
    LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row 

    'Define # rows in current red and clear 
    LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row 
    Range(ws2.Cells(2, 1), ws2.Cells(LastRow2, 70)).Clear 


    If Cond1 = "ALL" Then 
     For i = 6 To LastRow1 
      If ws1.Cells(i, 2) = "R" Then 
       LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row.Offset(1, 0) 
       ws1.Range(Cells(i, 1), Cells(i, 70)).Copy ws2.Range(Cells(LastRow2, 1)) 'Error occurs here 
      End If 
     Next i 
    Else 
     For i = 6 To LastRow1 
      If ws1.Cells(i, 2) = "R" Then 
       If ws1.Cells(i, 4) = Cond1 Or ws1.Cells(i, 4) = Cond2 Or ws1.Cells(i, 4) = Cond3 Then 
        LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1 
        ws1.Range(Cells(i, 1), Cells(i, 70)).Copy Destination:=ws2.Range(Cells(LastRow2, 1), Cells(LastRow2, 70)) 'Error occurs here 
       End If 
      End If 
     Next i 
    End If 

    End Sub 

私はちょうどにコードを変更した場合範囲を選択し、それをステップスルーして、両方のシートで正しい範囲を選択します。私はそれが何かシンプルだと確信していますが、私はこれを解決する方法を知っています。どんな助けも素晴らしいだろう。

Answer 1

セルの参照をすべてワークシートで完全修飾していない場所がいくつかありました。これは、アクティブなシートが行の一部に指定されているシートと異なる場合、エラーが発生します。また、Integer宣言をLongに変更しました。これはより効率的で、より大きなデータブロックに対応します。

Sub CopyRed() 

Dim ws1 As Worksheet 
Dim ws2 As Worksheet 
Dim LastRow1 As Long 
Dim LastRow2 As Long 
Dim check As Long 
Dim Cond1 As String 
Dim Cond2 As String 
Dim Cond3 As String 
Dim i As Long 

Set ws1 = Sheets(1) 
Set ws2 = Sheets(2) 

'set search criteria 
'define # rows in tool tracker 
Cond1 = ws1.Cells(1, 4) 
Cond2 = ws1.Cells(2, 4) 
Cond3 = ws1.Cells(3, 4) 
LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row 

'Define # rows in current red and clear 
LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row 
Range(ws2.Cells(2, 1), ws2.Cells(LastRow2, 70)).Clear 


If Cond1 = "ALL" Then 
    For i = 6 To LastRow1 
     If ws1.Cells(i, 2) = "R" Then 
      LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row.Offset(1, 0) 
      ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, 70)).Copy ws2.Cells(LastRow2, 1) 'Error occurs here 
     End If 
    Next i 
Else 
    For i = 6 To LastRow1 
     If ws1.Cells(i, 2) = "R" Then 
      If ws1.Cells(i, 4) = Cond1 Or ws1.Cells(i, 4) = Cond2 Or ws1.Cells(i, 4) = Cond3 Then 
       LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1 
       ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, 70)).Copy Destination:=ws2.Range(ws2.Cells(LastRow2, 1), ws2.Cells(LastRow2, 70)) 'Error occurs here 
      End If 
     End If 
    Next i 
End If 

End Sub