Question

我在Excel 2010中有一个电子表格，我希望连续获取某些单元格，并在将特定值输入同一行中的特定单元格时将它们复制到另一个工作表。

例如：在工作表A中，在单元格A2中，如果输入“X”，我希望将单元格A5，A7和A13-17复制到工作表B.在工作表B中，应将它们复制到下一个可用行，但我需要将它们复制到特定单元格（与工作表A中不同，即：单元格A5需要复制到工作表B中的单元格2; 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")

我非常感谢一些建议，因为我真的需要让它正常工作。如果不清楚，请告诉我。

Answer 1

我不确定你想要复制的内容以及你想要粘贴的位置，但希望这会让你开始朝着正确的方向前进：

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

Answer 2

未测试：

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

Answer 3

试试这个：

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)

Excel 2010：需要根据单元格值将某些单元格复制到不同的工作表

3 个答案: