vba Excel 2010：需要根据单元格值将某些单元格复制到不同的工作表
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18408124/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel 2010: Need to copy certain cells to different worksheet based on cell value
提问by jordanja72
I have a spreadsheet in Excel 2010, that I am wanting to take certain cells in a row and copy them to another worksheet when a certain value is entered into a specific cell in the same row.
我在 Excel 2010 中有一个电子表格，当某个值输入到同一行的特定单元格中时，我想将某些单元格连续取出并复制到另一个工作表中。
For example: In Worksheet A, in cell A2, if a "X" is entered, I want cell A5, A7 and A13-17 to be copied to Worksheet B. In Worksheet B, they should be copied to the next available row, but I need them copied to specific cells (not the same as in Worksheet A- i.e: cell A5 would need to copy to cell 2 in Worksheet B; A7 to cell 4 and A13-17 to 10-14). And the cells they would be copied to in Worksheet B would also need to be created in a new row.
例如：在工作表 A 中，在单元格 A2 中，如果输入“X”，我希望将单元格 A5、A7 和 A13-17 复制到工作表 B。在工作表 B 中，应将它们复制到下一个可用行，但我需要将它们复制到特定单元格（与工作表 A 中的不同 - 即：单元格 A5 需要复制到工作表 B 中的单元格 2；A7 到单元格 4 和 A13-17 到 10-14）。并且它们将在工作表 B 中复制到的单元格也需要在新行中创建。
I have some VBA that does something similar; however, it copies the entire row. For the above, I need only specific cells AND they won't match same cells in Worksheet B.
我有一些 VBA 做类似的事情；但是，它会复制整行。对于上述情况，我只需要特定的单元格并且它们不会匹配工作表 B 中的相同单元格。
Here is what I have been able to get to work (to copy entire row):
这是我能够开始工作（复制整行）：
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
I tried using the following instead of the entire row part, but does not work.
我尝试使用以下而不是整个行部分，但不起作用。
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")
I would greatly appreciate some advice, as I really need to get this working right. Please let me know if something is not clear.
我将不胜感激一些建议，因为我真的需要让它正常工作。如果有什么不清楚的地方，请告诉我。
采纳答案by tigeravatar
I'm not sure exactly what you want copied and where you want it pasted to, but hopefully this will get you started in the right direction:
我不确定您想要复制什么以及将它粘贴到哪里，但希望这能让您朝着正确的方向开始：
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
回答by Tim Williams
Untested:
未经测试：
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
回答by user2860181
try this :
尝试这个 ：
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)
