当活动工作表列中的任何单元格更改时，执行Excel宏将所有工作表复制到主工作表(Execute Excel Macro to Copy All Sheets to Master Sheet When Any Cell in Active Sheet Column Changes)
我有以下代码在F2：F251中的值更改时执行，但它没有正确执行（或者，更有可能，我写错了）。
当F2：F251在活动工作表中更改时，1月到12月的工作表A2：F251的内容应该复制到主工作表，以便新数据或已更改的旧数据始终在主工作表中是最新的。
但是，会发生的事情是活动工作表中的数据被覆盖，最终导致无限循环。 这是自动运行代码的问题，还是复制代码有问题？ 单独执行，在命令上，在主表上执行的复制代码正常运行。 此外，这似乎是执行我想要的操作的相当冗长的方式。 是否有一种更有效的明显替代方案？
Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range ' The variable KeyCells contains the cells that will ' cause an alert when they are changed. Set KeyCells = Range("F1:F251") If Not Application.Intersect(KeyCells, Range(Target.Address)) _ Is Nothing Then ' Copies contents A2:G251 from each monthly ' sheet to master record sheet. Sheets("MasterRecord").Activate Sheets("MasterRecord").Cells.ClearContents Dim NextRow As Range Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("January").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("February").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("March").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("April").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("May").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("June").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("July").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("August").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("September").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("October").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("November").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("December").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing End If End SubI have the following code that is executing when a value in F2:F251 changes, but it is not executing properly (or, more likely, I wrote it incorrectly).
When F2:F251 changes in the active sheet, the contents of A2:F251 of sheets January through December are supposed to copy to a master sheet so that new data, or old data that has been changed, will always be current in the master sheet.
However, what happens is that the data in the active sheet gets overwritten and I end up in an infinite loop. Is that a problem with the auto-run code, or is it a problem with the copying code? The copy code when executed alone, on command, on the master sheet functions properly. Also, this appears to be a rather verbose way of performing the actions that I want. Is there an apparent alternative that is more efficient?
Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range ' The variable KeyCells contains the cells that will ' cause an alert when they are changed. Set KeyCells = Range("F1:F251") If Not Application.Intersect(KeyCells, Range(Target.Address)) _ Is Nothing Then ' Copies contents A2:G251 from each monthly ' sheet to master record sheet. Sheets("MasterRecord").Activate Sheets("MasterRecord").Cells.ClearContents Dim NextRow As Range Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("January").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("February").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("March").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("April").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("May").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("June").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("July").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("August").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("September").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("October").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("November").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing Set NextRow = Range("A" & Sheets("MasterRecord").UsedRange.Rows.Count + 1) Sheets("December").Range("A2:G251").Copy Sheets("MasterRecord").Activate NextRow.PasteSpecial Paste:=xlValues, Transpose:=False Application.CutCopyMode = False Set NextRow = Nothing End If End Sub最满意答案
要回答实际问题 - 您的代码进入无限循环的原因有两个：
您没有在事件中禁用事件，因此通过粘贴F2:F251范围，您将一次又一次地触发事件。 您正在获取MasterRecord的最后一行，但您没有在MasterRecord上使用Range ，而是使用事件被触发的工作表。您必须确保在处理使用期望工作表范围的范围时。 由于所有工作表都只是对象，因此在Sheet模块中调用Range默认为Me.Range ，因此使用该工作表。
我相信以下内容可以满足您的需求，而无需重复：
Option Explicit Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) ' Target is already a range, no need to get the address explicitly If (Intersect(Target, Sh.Range("F1:F251")) Is Nothing) Then Exit Sub Application.EnableEvents = False Application.ScreenUpdating = False Dim master As Worksheet: Set master = ThisWorkbook.Worksheets("MasterRecord") Dim ws As Worksheet Dim sheets As Variant: sheets = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December") Dim sheet As Variant master.Cells.ClearContents For Each sheet In sheets Set ws = ThisWorkbook.Worksheets(sheet) ws.Range("A2:G251").Copy master.Range("A" & master.Range("A" & master.Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues Next Set master = Nothing Set ws = Nothing Application.EnableEvents = True Application.ScreenUpdating = True End Sub编辑
看起来只有当你想在所有工作表上发生这种情况时才需要改变它才会将它放在ThisWorkbook模块的Workbook_SheetChange方法中。 请注意，顶部附近不再有Me.Range，而是Sh.Range。 由于工作表正在调用此方法，因此我认为使用Sh.Range vs Range会产生很大差异，但它永远不会受到伤害。
To answer the actual question - the reason your code is going in to an infinite loop is due to two reasons:
You have not disabled events within the event, so by pasting over the range F2:F251 you are firing the event again and again and again. You are getting the last row of MasterRecord, but you are not using the Range on MasterRecord, rather, the sheet the event was fired from.You must ensure when dealing with ranges that you use the range of the worksheet you expect. Since all worksheets are really just objects, calling Range within the Sheet module defaults to Me.Range, thus using that worksheet.
I believe the following accomplishes what you need, without duplication:
Option Explicit Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) ' Target is already a range, no need to get the address explicitly If (Intersect(Target, Sh.Range("F1:F251")) Is Nothing) Then Exit Sub Application.EnableEvents = False Application.ScreenUpdating = False Dim master As Worksheet: Set master = ThisWorkbook.Worksheets("MasterRecord") Dim ws As Worksheet Dim sheets As Variant: sheets = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December") Dim sheet As Variant master.Cells.ClearContents For Each sheet In sheets Set ws = ThisWorkbook.Worksheets(sheet) ws.Range("A2:G251").Copy master.Range("A" & master.Range("A" & master.Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues Next Set master = Nothing Set ws = Nothing Application.EnableEvents = True Application.ScreenUpdating = True End SubEdit
Looks like the only that needs to change if you want to have this happen on all Worksheets is placing it in the Workbook_SheetChange method in the ThisWorkbook module. Note that there is no longer Me.Range near the top, but rather Sh.Range. Since a worksheet is calling this method, I don't think it would make much of a difference using Sh.Range vs Range, but it never hurts.
更多推荐
发布评论