0

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

我将不胜感激一些建议，因为我真的需要让它正常工作。如果有不清楚的地方，请告诉我。

4

3 回答 3

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)
于 2013-10-08T20:08:30.273 回答
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
于 2013-08-23T17:10:43.913 回答
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
于 2013-08-23T17:18:47.983 回答