在VBA中将行从工作表复制和删除到多个工作表

Posted 2023-03-27

【中文标题】在VBA中将行从工作表复制和删除到多个工作表

【英文标题】：Copy and Delete Rows from sheet to multiple sheets in VBA

【发布时间】：2021-10-24 04:32:51

【问题描述】：

我有一个主工作表和其他工作表，它们的前 2 列包含我的项目的唯一 ID（A 列）和项目名称（B 列）。 我希望我的同事仅使用带有 ID 和项目名称的主表进行更新，以便：

当您删除主表中的 ID 和项目名称时，所有其他表也会受到影响，即所有 ID 和项目名称都需要删除 当他们复制主表中的新 ID 和项目名称时，所有其他表也会相应更新

我编写了下面的代码，但是当我删除 ID 和项目时发生了一些奇怪的事情（在所有其他工作表中只删除了第一 2 行，并且在第 1 行中添加了主工作表的标题）。当主表为空并且我复制 ID 和项目名称时，代码似乎有效。 我错过了一些我无法理解的东西：

Sub CopyAndDeleteList()
Dim sourceWs As Worksheet, destinationWs As Worksheet, destinationLastRow As Long
Set sourceWs = ThisWorkbook.Worksheets("Master")
Set destinationWs = ThisWorkbook.Worksheets("MySheetName")
destinationLastRow = sourceWs.Range("A" & Rows.Count).End(xlUp).Row
Call sourceWs.Range("A2:A" & destinationLastRow).Copy(destinationWs.Range("A3"))
Call sourceWs.Range("B2:B" & destinationLastRow).Copy(destinationWs.Range("B3"))
End Sub

然后我将以上内容添加到主工作表更改事件中：

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A2:B100")) Is Nothing Then
    
      Call CopyAndDeleteList
End If
End Sub

以下是一些截图：

这是从外部来源粘贴数据时的主工作表示例：

这里粘贴一个数据，运行代码，然后数据也自动粘贴到Sheet1中。

但是，当我必须更改我的 ID（因为该文件被其他用户使用或因为我的客户发生更改）时，我要做的第一件事是删除主表中的旧 ID，这就是 Sheet1 中发生的情况：

谢谢

【问题讨论】：

如果第一列包含唯一值，你为什么要提那么多名字？删除 ID 和名称是什么意思？您的意思是删除整行还是每个工作表上仅有的两列？其他工作表是否以 ID 或名称命名，即我如何知道将新 ID 和名称复制到哪个工作表？请澄清并添加一些工作表的屏幕截图。

您好，答案是：因为我需要 ID 和客户姓名。这意味着由于文件被很多人使用，每个人都有自己的客户，然后再添加他们自己的客户，他们需要取消旧的客户。我的意思是删除行中包含的所有值。不，工作表不是以 ID 或名称命名的。您知道在哪里复制，因为这在代码中是明确的。基本上我需要其他 10 张表格中的 ID 和名称，因为它们向我们展示了客户与特定产品随时间推移的进展（每周更新）。希望这更清楚。

只是好奇，您的工作表 1 中的第 2 行（A 列和 B 列）最初是空白的吗？或者最初有一个值 - 这就是复制目标位于第 3 行的原因？

可能是因为当您删除主表中的整个数据（您只留下标题）时，它会复制标题及其下方的一个空白行（第 2 行）---> 然后将其粘贴到工作表 1 的第 3 行。这就是为什么您在工作表 1 中看到标题是双倍的，并且它不会删除工作表 1 中的其余行，因为您粘贴的只有两行，一行带有标题，一行在它下面是空白的。

也许尝试在copy:destination 代码行之前清除 sheet1 firat 的 A 和 B 列

【参考方案1】：

我做到了，下面是代码供以后参考：

Sub CopyList()
Dim sourceWs As Worksheet, destinationWs As Worksheet, destinationLastRow As Long
Set sourceWs = ThisWorkbook.Worksheets("Master")
Set destinationWs = ThisWorkbook.Worksheets("Sheet1")
destinationLastRow = sourceWs.Range("A" & Rows.Count).End(xlUp).Row
Call sourceWs.Range("A2:A" & destinationLastRow).Copy(destinationWs.Range("A2"))
Call sourceWs.Range("B2:B" & destinationLastRow).Copy(destinationWs.Range("B2"))
End Sub
Sub DeleteList()
Dim destinationWs As Worksheet, destinationLastRow As Long
Set destinationWs = ThisWorkbook.Worksheets("Sheet1")
destinationLastRow = destinationWs.Range("A" & Rows.Count).End(xlUp).Row
destinationWs.Range("A2:B" & destinationLastRow).ClearContents
End Sub

在大师中：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim UndoList As String
UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)
If Left(UndoList, 5) = "Paste" Then
If Not Intersect(Target, Range("A2:B100")) Is Nothing Then
MsgBox "Copied"
Call CopyList
Exit Sub
End If
ElseIf WorksheetFunction.CountBlank(Target) = Target.Cells.Count Then
MsgBox "Deleted"
Call DeleteList
Exit Sub
End If
End Sub