运行代码后，范围值发生变化并出现错误 REF

Question

我有一个工作簿，其中包含名为 Alert* 的各种工作表（每个警报工作表名称上都有不同的日期）和客户工作表。我运行代码以将信息复制并粘贴到名为 client 的 2 张工作表中的时间我遇到了问题。

复制和粘贴工作正常。但是，它会删除我所有名为 Alert* 的工作表中 Range（“K16”、“C1”和“C2”）中的信息。这不是什么大问题，因为我仍然可以从客户表中再次复制此信息。

我正在尝试多种方法来复制和粘贴代码，但我无法使其正常工作。

Dim sht As Worksheet
Dim sw As Worksheet: Set sw = Sheets("Client*")

 For Each sht In Worksheets
    If sht.Name Like "Alert*" Then
        sht.Range("K16").Value = sw.range("J3")
        sht.Range("C1").Value = sw.range("C1")
        sht.Range("C2").Value = sw.range("C2")
    End If
Next ws

我试试 暗淡为工作表 设置 sht = worksheets("Alert*)

ActiveSheet.Range("J3").Copy sht.Range("K16") ActiveSheet.Range("C1:C2").Copy sht.Range("C1:C2")

但它不起作用。

也许可以使用循环来检查所有名为 Alert* 的工作表，并将客户工作表中的信息粘贴到正确的范围内。

Answer 1

如果我们假设您手动或通过其他未显示的方法创建名为“客户审核”的新工作表，我相信以下内容将帮助您实现所需的结果。

它本质上会寻找一个名为"Client Review*"（我们称之为工作表A）的工作表，然后将该工作表中的范围复制到"Client Review"（工作表B），然后它将删除A并将B重命名为上面有一个日期戳，因此当您在重新创建 "Client Review" 工作表（即工作表 A）的另一天重新运行时。

如果我上面所说的一切都有意义，那么您必须确保在重新创建 Client Review 工作表后更新 K16 的公式。

我添加了另一个类似于您的循环，以确保每个名为 Client* 的工作表都具有公式 ("='" & ws.Name & "'!J3")

Sub CopyOldToNew()
Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False 'For less lag
Dim wsClientReview As Worksheet: Set wsClientReview = ThisWorkbook.Worksheets("Client Review")
Dim wsPreviousClientReview As Worksheet
Dim ws As Worksheet

On Error GoTo ErrorTrue

today = Format(Date, "MM.DD.YYYY")
For Each wsPreviousClientReview In ThisWorkbook.Worksheets
    If wsPreviousClientReview.Name Like "Client Review*" And wsPreviousClientReview.Name <> "Client Review" Then
        'wsPreviousClientReview.Activate
        Exit For
    End If
Next ws

wsPreviousClientReview.Range("A22:N250").Copy

wsClientReview.Range("A22:N250").Paste
wsClientReview.Range("J3").Value = wsPreviousClientReview.Range("J3").Value
wsClientReview.Range("G8:H12").Value = wsPreviousClientReview.Range("G8:H12").Value
wsClientReview.Name = "Client Review " & Format(Date, "mm.dd.yyyy")
ws.Delete

wsClientReview.Move before:=Thisworbkook.Sheets(1)

For Each ws In Worksheets
    If ws.Name Like "Client*" Then
        ws.Range("K16").Value = wsClientReview.Range("J3").Value
    End If
Next ws

Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True
Exit Sub

ErrorTrue:
MsgBox "No manually added sheets identified."
Alert.Activate
Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True
End Sub