после запуска кода значение диапазона изменяется и появляется ошибка REF

Question

У меня есть книга с различными листами с именем Alert * (каждое имя листа Alert имеет разную дату) и лист клиента. Когда я запускаю код для копирования и вставки информации на 2 листа с именем client, у меня возникает проблема.

Копирование и вставка работают нормально. Однако он удаляет информацию в диапазоне («K16», «C1» и «C2») на всех моих листах с именем Alert *. Это не большая проблема, потому что я все еще могу скопировать эту информацию еще раз с клиентского листа.

Я пробую много способов скопировать и вставить код, но не могу заставить его работать.

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 Worksheet установить sht = worksheets ("Alert *)

ActiveSheet.Range (" J3 "). Копировать sht.Range (" K16 ") ActiveSheet. Range ("C1: C2"). Скопируйте sht.Range ("C1: C2")

Но он не работает.

Возможно, можно было бы использовать al oop для проверьте все листы с именем Alert * и вставьте информацию из листа клиента в правильный диапазон.

Answer 1

Если предположить, что вы создаете новый рабочий лист с именем «Обзор клиента» вручную или каким-либо другим способом, который не показан, я считаю, что приведенный ниже код поможет вам достичь желаемого результата.

По сути, это будет выглядеть для рабочего листа с именем "Client Review*" (назовем этот рабочий лист A), затем скопируйте диапазоны из этого рабочего листа в "Client Review" (рабочий лист B), а затем он удалит A и переименует B, чтобы на нем была отметка даты, поэтому когда вы повторно запустите это в другой день, когда вы воссоздали рабочий лист "Client Review" (т.е. рабочий лист A).

Если все, что я сказал выше, имеет смысл, тогда вам нужно будет обновить формулу для K16 один раз вы воссоздали рабочий лист Client Review.

Я добавил еще один l oop, похожий на ваш, чтобы гарантировать, что каждый рабочий лист с именем 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