2013-08-23 2 views
0

Excel 2010에 스프레드 시트가 있는데 특정 셀을 연속으로 가져 와서 특정 값을 입력하면 다른 워크 시트로 복사하려고합니다. 같은 행의 특정 셀Excel 2010 : 셀 값을 기반으로 특정 셀을 다른 워크 시트에 복사해야합니다.

예 : 워크 시트 A의 A2 셀에서 "X"를 입력하면 A5, A7 및 A13-17 셀을 워크 시트 B에 복사합니다. 워크 시트 B에서 셀 B에 복사해야합니다. 사용할 수있는 다음 행이 있지만 특정 셀에 복사해야합니다 (Worksheet A-와 같지 않음 : 셀 A5는 워크 시트 B의 셀 2에, A7은 셀 4에, A13-17은 10-14로 복사해야 함). 워크 시트 B에 복사 할 셀을 새 행으로 만들어야합니다.

비슷한 VBA를 사용하고 있습니다. 그러나 전체 행을 복사합니다.

Sub Testing_Issue(ByVal Target As Range) 
    'Disable events so code doesn't re-fire when row is deleted 
    Application.EnableEvents = False 
    'Was the change made to Column T? 
    If Target.Column = 20 Then 
    'If yes, does the Target read "Y"? 
    If Target = "Y" Then 
    'If Y, determine next empty row in Sheet "TEST" 
    nxtRw = Sheets("TEST").Range("A" & Rows.Count).End(xlUp).Row + 1 

    'Copy the row from the Open worksheet and move to the TEST worksheet 
    Target.EntireRow.Copy Destination:=Sheets("TEST").Range("A" & nxtRw) 
    Else 
     MsgBox ("That is not a valid entry") 
    End If 
    End If 
'Re-enable Events 
    Application.EnableEvents = True 
End Sub 

:

여기

내가 (전체 행을 복사) 작업을 얻을 수 있었던 것입니다 위, 나는 특정 세포를 필요로하고 그들은 워크 시트 B에 같은 세포와 일치하지 않습니다 전체 행 부분 대신 다음을 사용하여 시도했지만 작동하지 않습니다.

Target.Range("A13").Copy Destination:=Sheets("TEST").Range("A5 & nxtRw") 
Target.Range("B13").Copy Destination:=Sheets("TEST").Range("C5 & nxtRw") 
Target.Range("I13:J13").Copy Destination:=Sheets("TEST").Range("E5 & nxtRw") 

나는이 작업을 올바르게 수행해야하므로 몇 가지 조언을 크게 부탁드립니다. 확실하지 않은 점이 있으면 알려주십시오.

답변

0

난 당신이 복사하려는 정확히 잘 모르겠어요 그리고 당신은에 붙여, 그러나 희망이 당신이 올바른 방향으로 시작하는 곳을 원하는 :

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim rngCheck As Range 
    Dim CheckCell As Range 
    Dim lRow As Long 

    Set rngCheck = Intersect(Me.Columns("T"), Target) 

    If Not rngCheck Is Nothing Then 
     For Each CheckCell In rngCheck.Cells 
      If CheckCell.Value = "Y" Then 
       With Sheets("TEST") 
        lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 
        Me.Cells(CheckCell.Row, "A").Copy Destination:=.Cells(lRow, "A") 
        Me.Cells(CheckCell.Row, "C").Copy Destination:=.Cells(lRow, "B") 
        Me.Cells(CheckCell.Row, "I").Copy Destination:=.Cells(lRow, "E") 
        Me.Cells(CheckCell.Row, "J").Copy Destination:=.Cells(lRow, "F") 
       End With 
      End If 
     Next CheckCell 
    End If 

End Sub 
+0

tigeravatar - 고마워요! 이것은 완벽하게 작동했습니다 ... 나는 잠시 동안 작동하도록 키보드를 상대로 머리를 치고 다른 사이트에서 도움을 얻을 수 없었습니다. 다시 한 번 감사드립니다! – jordanja72

0

테스트되지 않은 :

Sub tester(rng As Range) 
Dim rwSrc As Range, rwDest As Range 

    Set rwSrc = rng.Cells(1).EntireRow 

    If UCase(rwSrc.Cells(2).Value) = "X" Then 
     Set rwDest = ThisWorkbook.Sheets("B").Cells(_ 
      Rows.Count, "A").End(xlUp).Offset(1, 0).EntireRow 

     rwSrc.Cells(5).Copy rwDest.Cells(2) 
     rwSrc.Cells(7).Copy rwDest.Cells(4) 
     rwSrc.Cells(13).Resize(1, 5).Copy rwDest.Cells(10) 
    End If 
End Sub 
0

이것을 시도하십시오 :

Target.Range("A13").Copy Destination:=Sheets("TEST").Range("A5" & nxtRw) 
Target.Range("B13").Copy Destination:=Sheets("TEST").Range("C5" & nxtRw) 
Target.Range("I13:J13").Copy Destination:=Sheets("TEST").Range("E5" & nxtRw) 
관련 문제