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

Question

我有一个工作簿，里面有各种名为Alert*的工作表(每个Alert工作表名称上都有不同的日期(和客户端工作表。当我运行代码来复制和粘贴两张名为client的表中的信息时，我遇到了一个问题。

复制和粘贴操作正常。但是，它会删除我所有名为警报*的工作表中范围("K16"、"C1"one_answers"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

我试着Dim sht As Worksheetset sht=工作表("Alert*"(

ActiveSheet.Range("J3"(。复制sht。范围("K16"(ActiveSheet.Range("C1:C2"(。复制sht。量程("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