셀의 범위를 다른 셀의 값으로 복사하는 방법

Question

각 루프마다 a와 함께 주어진 셀 범위를 통과하는 코드를 작성하고 있습니다. theses 호출 "if each"with if 문을 만족하지 않으면 다른 셀에 해당 셀의 범위를 써야합니다. 예 : 셀 A20과 A36이 일치하지 않아 다른 시트에 A20과 36을 쓰고 싶습니다. 이 방법은 내가 관심을 필요로하는 모든 세포의 목록을 갖습니다. 여기 내 코드는 다음과 같습니다.

r = 5 
    Set sht1 = Sheets("DataSheet") 
    Set sht2 = Sheets("DiscrepancyReport") 
On Error GoTo DiscrepancySheetError 
    sht2.Select 
On Error GoTo DataSheetError 
    sht1.Select 
On Error GoTo 0 

     lastr = ActiveSheet.range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row 
     lastr = lastr - 1 

'Column 1: WP 
     Set colrg = range("A3:A" & lastr) 
      For Each cell In colrg 
       If (cell.Value) = 6.01 Or (cell.Value) = 6.03 Or (cell.Value) = 3.04 Or (cell.Value) = 6.27 Then 
       Else 
        '## The following line makes no sense but i wrote it so you understand what i want to do 
        currentcell.range.Copy Destination:=sht2.range("A" & r) 
        ActiveCell.Offset(0, 1).Select 
         ActiveCell.Value = "Not a valid WP" 
        r = r + 1 
       End If 
      Next 

미리 감사드립니다!

Answer 1

난 당신이 데이터 시트에 "아니 유효한 WP"를 넣고 싶었 겠지,하고 복사를 사용할 필요가 없다 :

여기

Sub CollectRanges() 
    r = 5 
    Set sht1 = Sheets("DataSheet") 
    Set sht2 = Sheets("DiscrepancyReport") 
'On Error GoTo DiscrepancySheetError 
    sht2.Select 
'On Error GoTo DataSheetError 
    sht1.Select 
On Error GoTo 0 

     lastr = ActiveSheet.Range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row 
     lastr = lastr - 1 

'Column 1: WP 
     Set colrg = Range("A3:A" & lastr) 
      For Each cell In colrg 
       If (cell.Value) = 6.01 Or (cell.Value) = 6.03 Or (cell.Value) = 3.04 Or (cell.Value) = 6.27 Then 
       Else 
        sht2.Cells(r, 1).Value = cell.Address 
        cell.Offset(0, 1).Value = "Not a valid WP" 
        r = r + 1 
       End If 
      Next 
End Sub 

Answer 2

다음은 데이터가 3 행에서 시작한다고 가정하고 업데이트 된 코드입니다.
코드에서 선택/활성화를 사용하지 마십시오. 참고이 link

Sub test() 

    Dim sht1 As Worksheet 
    Dim sht2 As Worksheet 
    Dim r As Long, lastr As Long 

    r = 3 
    Set sht1 = Sheets("DataSheet") 
    Set sht2 = Sheets("DiscrepancyReport") 

    With sht1 
     lastr = .Range("A" & .Rows.Count).End(xlUp).Row 
     If lastr < 3 Then lastr = 3 

     Set colrg = Range("A3:A" & lastr) 
    End With 


    For Each cell In colrg 
     If (cell.Value) = 6.01 Or (cell.Value) = 6.03 Or (cell.Value) = 3.04 Or (cell.Value) = 6.27 Then 
     Else 
      '## The following line makes no sense but i wrote it so you understand what i want to do 
      cell.Copy Destination:=sht2.Range("A" & r) 
      sht2.Range("B" & r) = "Not a valid WP" 
      r = r + 1 
     End If 
    Next 


End Sub 

Answer 3

가 업데이트 된 코드는 Andy 's와 Santosh의 코드 -

Sub test() 

Dim sht1 As Worksheet 
Dim sht2 As Worksheet 
Dim r As Long, lastr As Long 

r = 3 
Set sht1 = Sheets("DataSheet") 
Set sht2 = Sheets("DiscrepancyReport") 

With sht1 
    lastr = .Range("A" & .Rows.Count).End(xlUp).Row 
    If lastr < 3 Then lastr = 3 

    Set colrg = Range("A3:A" & lastr) 
End With 


For Each cell In colrg 
    If (cell.Value) <> 6.01 Or (cell.Value) <> 6.03 Or (cell.Value) <> 3.04 Or (cell.Value) <> 6.27 Then 
     '## The following line makes no sense but i wrote it so you understand what i want to do 
     sht2.Range("A" & r).value=Replace(cell.Address, "$", "") 

     'Comment the appropriate one below 

     'If you want this to be written in the 2nd sheet, below is the code, else comment it. 
     sht2.Range("B" & r) = "Not a valid WP" 

     'If you want this to be written in the 1st sheet, below is the code, else comment it. 
     cell.offset(0,1).value = "Not a valid WP" 
     r = r + 1 
    End If 
Next 

End Sub 

희망이 있습니다.