Макрос перестает работать после первого запуска - ошибка времени выполнения 2004 Ошибка, определяемая приложением или объектом

Question

Я пытаюсь собрать макрос, который находит имя в заголовке столбца, а затем копирует этот столбец, если заголовок совпадает.

Он работает при первом запуске, но когда вставленный столбец удаляется и макрос запускается снова, я получаю

Ошибка выполнения 2004 Ошибка, определяемая приложением или объектом

в этой строке:

Set sRange = Sheets("Data").Range("C1", Cells(1, LastCol))

Полный код:

Sub Copy()

Dim Cell As Range, sRange As Range, Rng As Range

    LastCol = Sheets("Data").Cells(1, Columns.Count).End(xlToLeft).Column

        Set sRange = Sheets("Data").Range("C1", Cells(1, LastCol))

            With sRange

                Set Rng = .Find(What:="Chennai", _
                                After:=.Cells(1), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False)

                    If Not Rng Is Nothing Then

                        Lastrow = Sheets("Data").Cells(Rows.Count, Rng.Column).End(xlUp).Row

                            Sheets("Data").Range(Rng, Cells(Lastrow, Rng.Column)).Copy _
                                Destination:=Sheets("Summary").Range("A7")
                    End If
            End With
End Sub

Кто-нибудь видит проблему?

Answer 1

Для

Cells(1, LastCol)) рабочий лист не указан. Следовательно, это то же самое, что и ActiveSheet.Cells(1, LastCol)), и если Sheets("Data") не ActiveSheet, это не удается.

Это должно быть

Set sRange = Worksheets("Data").Range("C1", Worksheets("Data").Cells(1, LastCol))

или даже лучше

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Data")

Set sRange = ws.Range("C1", ws.Cells(1, LastCol))

Также я рекомендую использовать Worksheets для рабочих листов, поскольку Sheets может также содержать листы диаграмм и т.д. c.

Та же проблема в конце, где Cells(Lastrow, Rng.Column) не указан рабочий лист:

ws.Range(Rng, ws.Cells(Lastrow, Rng.Column)).Copy _
                            Destination:=Worksheets("Summary").Range("A7")

---

Убедитесь, что у вас никогда нет объекта Cells, Range, Rows или Columns без указанного рабочего листа. Или Excel может взять неправильный лист.

В конце я бы сделал что-то вроде (обратите внимание, что все переменные должны быть объявлены, используйте Option Explicit:

Option Explicit 

Public Sub Copy()
    Dim wsSrc As Worksheet 'source worksheet
    Set wsSrc = ThisWorkbook.Worksheets("Data")

    Dim wsDest As Worksheet 'destination worksheet
    Set wsDest = ThisWorkbook.Worksheets("Summary")

    Dim LastCol As Long
    LastCol = wsSrc.Cells(1, wsSrc.Columns.Count).End(xlToLeft).Column

    Dim sRange As Range
    Set sRange = wsSrc.Range("C1", wsSrc.Cells(1, LastCol))

    Dim Rng As Range
    Set Rng = sRange.Find(What:="Chennai", _
                          After:=sRange.Cells(1), _
                          LookIn:=xlValues, _
                          LookAt:=xlWhole, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False)

    If Not Rng Is Nothing Then
        Dim LastRow As Long
        LastRow = wsSrc .Cells(wsSrc.Rows.Count, Rng.Column).End(xlUp).Row

        wsSrc.Range(Rng, wsSrc.Cells(LastRow, Rng.Column)).Copy _
                                Destination:=wsDest.Range("A7")
    End If
End Sub