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：需要根据单元格值将某些单元格复制到不同的工作表中

回答

相关问题