Excel 2010：需要根據單元格值將某些單元格複製到不同的工作表中

我在Excel 2010中有一個電子表格，我希望在某一行中輸入特定值並將其複製到另一個工作表中同一行中的特定單元格。Excel 2010：需要根據單元格值將某些單元格複製到不同的工作表中

例如：在工作表A中，在單元格A2中，如果輸入了「X」，我希望單元格A5，A7和A13-17被複制到工作表B.在工作表B中，它們應該被複制到下一個可用的行，但我需要它們複製到特定的單元格（不同於在工作表A - 即：單元格A5需要複製到單元格2在工作表B中; A7到單元格4和A13-17到10-14）。他們將被複制到工作表B中的單元格也需要在新行中創建。

我有一些VBA可以做類似的事情;但是，它會複製整個行。針對上述情況，我只需要特定的細胞，他們不會在工作表B.匹配相同的細胞

以下是我已經能夠去上班（複製整行）：

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

我嘗試使用以下而不是整個行部分，但不起作用。

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")

我非常感謝一些建議，因爲我真的需要得到這個工作的權利。請讓我知道，如果有什麼不明確的。

來源

2013-08-23 jordanja72

我不知道你想複製什麼和你想要它粘貼到，但希望這將讓你在正確的方向開始：

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

來源

2013-08-23 17:10:43 tigeravatar

tigeravatar - 謝謝！這工作完美...我一直在敲我的頭對着鍵盤試圖讓這個工作一段時間，並沒有能夠得到任何其他網站的幫助。再次感謝！ – jordanja72

未經測試：

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

來源

2013-08-23 17:18:47

試試這個：

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)

來源

2013-10-08 20:08:30 user2860181

Excel 2010：需要根據單元格值將某些單元格複製到不同的工作表中

回答

相關問題