将特定单元格复制到另一个工作表

Question

我在 Excel 中有 2 张工作簿（2017 年和 2018 年）。

当在同一行的特定单元格中输入某个值时，我想从工作表 2017 中取出某些单元格并将它们复制到工作表 2018。

例如：在工作表 2017 中，在单元格 A2 中，如果输入“X”，我希望将单元格 B2、C2 和 G2 复制到工作表 2018。在工作表 2018 中，应将它们复制到下一个空行并从工作表 2017 中删除。 对于 2017 年 A 列中包含“X”的每一行，依此类推。

谁能帮我解决这个 VBA 头痛问题？

Answer 1

试试这个代码

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim e           As Variant
    Dim lr          As Long
    Dim r           As Long

    If Target.Count = 1 And Target.Column = 1 Then
        With Sheets("2018")
            lr = .Cells(Rows.Count, 2).End(xlUp).Row + 1
            r = Target.Row

            If Target = "X" Then
                Application.EnableEvents = False
                    For Each e In Array("B", "C", "G")
                        .Range(e & lr) = Range(e & r)
                        Range(e & r).ClearContents
                    Next e
                Application.EnableEvents = True
            End If
        End With
    End If
End Sub

如果您需要为所有行使用按钮，则可以使用此代码

Sub Test()
    Dim ws          As Worksheet
    Dim e           As Variant
    Dim lr          As Long
    Dim r           As Long

    Set ws = ThisWorkbook.Sheets("2017")
    
    With Sheets("2018")
        For r = 1 To ws.Cells(Rows.Count, 2).End(xlUp).Row
            If ws.Cells(r, 1) = "X" Then
                lr = .Cells(Rows.Count, 2).End(xlUp).Row + 1
                For Each e In Array("B", "C", "G")
                    .Range(e & lr) = ws.Range(e & r)
                    ws.Range(e & r).ClearContents
                Next e
            End If
        Next r
    End With
End Sub

或者如果你使用过滤方法会更好