Код VBA просто останавливается в середине выполнения без завершающего кода (НЕ ХАНГ)

Question

У меня есть некоторый код, который копирует более 1K файлов или около того с сетевого диска на сайт SharePoint. Когда он завершил эту задачу, он вызывает следующую подпрограмму. Когда я перехожу через код, он, кажется, работает нормально, и он работал хорошо в некоторых небольших загруженных списках. Однако, когда я просто позволяю ему работать, он волшебным образом прекращает выполнение кода и ведет себя так, как будто все успешно выполнено. Я знаю, что это не так, потому что рабочая книга, которую я выбрал открытой, все еще открыта, а рабочая книга, из которой я запускаю код, пуста.

Лучшее, что я могу догадаться, это код, который перестает выполняться сразу:

SourceWB.Sheets("Sheet1").Activate

Поскольку лист назначения все еще пуст, я почти уверен, что ячейка cell.copy не выполняется. Единственное, о чем я могу думать, это то, что он каким-то образом захватывает рабочий лист в качестве исходного рабочего листа, поэтому на самом деле ничего не копируется, и я получаю чистый лист. Я исключаю это, хотя, как и в конце моей основной подпрограммы, должно появиться окно сообщения, когда все будет готово, и окно сообщения не появится.

Может ли кто-нибудь заметить проблему или пролить свет на то, что может происходить. Разочаровывает, что это работает, когда шагая. (до тех пор, пока есть точка останова)

Sub ImportIndex()

'Copies Sheet1 from a user selected workbook
'into current work book

    Dim DestinationWS As Worksheet
    Dim DestinationR As Range
    Dim SourceWB As Workbook
    Dim FilenameWB As String

    'clear sheet1 of any previous data/formats etc
    Clear_Worksheet ("Sheet1")

    'Set the location of where the sheet is to be copied to
    Set DestinationWS = ThisWorkbook.Sheets("Sheet1")
    Set DestinationR = DestinationWS.Range("A1")

    'Open the source workbook through file picker
    '****************************************************************
    'Error may occur if workbook is already open
    'Look into how to deal with this in the future
    '****************************************************************
    FilenameWB = Application.GetOpenFilename()

    Set SourceWB = Workbooks.Open(Filename:=FilenameWB)

    'Ensure "sheet1" is the active worksheet
    SourceWB.Sheets("Sheet1").Activate

    'Copies active wrokesheet to Destination
    Cells.Copy DestinationR

    'close the source workbook without saving changes
    SourceWB.Close savechanges:=False

End Sub

Я посмотрел на следующий вопрос, но он был связан с Word. Согласно одному из комментариев, последняя сборка, похоже, решила их проблему.

Функция очистки рабочего листа по запросу

Sub Clear_Worksheet(Sheetname As String)
'Deletes all cells in the provide worksheet name
'currently will cause an error if the sheet does not exist
    With ThisWorkbook.Sheets(Sheetname)
        .Cells.Delete Shift:=xlUp
        Range("A1").Activate 'probably do no need this activate
    End With

End Sub

Я только что перезапустил код, исключив ACTIVATE, а также удалив все точки останова шага. Я также изменил строку копирования на «SourceWB.Sheets (« Sheet1 »). Cells.Copy», как было предложено. Код по-прежнему не выполнялся после открытия листа и перед копированием листа в Thisworkbook.

в примечании, я также иногда замечаю, что во время пошагового выполнения кода и выбора файла или папки код кажется завершенным, если у меня не установлена ​​точка останова где-то немного позже.

Answer 1

Я прокомментировал, что не уверен, почему это прекратилось бы ... я догадываюсь, что это может быть из-за очень большого диапазона, который вы копируете (весь лист ...).

Вам следует либо задать диапазон копируемого объекта (от ячейки 1 до последней строки / столбца), либо в этом случае, поскольку вы не добавляете к ранее существующим данным, может быть лучше просто скопировать лист.

Посмотрите, поможет ли такое переписывание вашего кода?

Sub ImportIndex()
'Copies Sheet1 from a user selected workbook
'into current work book

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
    Dim SourceWB As Workbook
    Dim FilenameWB As String

    'Open the source workbook through file picker
    On Error Resume Next
    FilenameWB = Application.GetOpenFilename()
    Set SourceWB = Workbooks.Open(Filename:=FilenameWB)
    On Error GoTo 0

    If Not SourceWB Is Nothing Then
        'ws.Name = "something else" 'rename this if you want to keep "Sheet1" name from the source workbook
        SourceWB.Sheets("Sheet1").Copy After:=ws
        ws.Delete

        'close the source workbook without saving changes
        SourceWB.Close savechanges:=False
    Else
        'Some error handling here... msgbox/debug.print etc
    End If

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With

End Sub

PS: обратите внимание, что существуют разные способы открытия книги, но по причинам простоты это должно работать просто отлично.