Excel VBA 선택없이 한 시트에서 다른 시트로 복사

Question

일부 셀의 내용을 기준으로 한 시트에서 다른 시트로 선택된 범위 만 복사하려고합니다. 내가 개발 한 코드는 실제로 정보를 복사하여 붙여 넣으려고 할 때까지 작동합니다. 비슷한 코드를 사용하여 여러 사이트를 검토 한 결과, 차이점은 특정 범위로 실행하려고하는 것입니다. 런타임 오류 '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