Макрос, выходящий рано без ошибки

Question

Я использую код ниже, чтобы скопировать все рабочие тетради из определенной папки в одну рабочую книгу.9 из 10 раз Код работает нормально, и все данные копируются, но иногда макрос появляется, чтобы выйти рано, без окончания, так как MSGBox никогда не отображается, и я не получаю никакого сообщения об ошибке.Макрос, по-видимому, был выходом, так как он позволяет мне запустить другие макросы.Может кто-нибудь посоветовать мне, что может заставить это?Похоже, случается, если вы начнете делать другие вещи на вашем компьютере, пока работает макрос.

Sub GetSheets()

Application.ScreenUpdating = False

Dim response
 response = MsgBox("This will take some time to run. Are you sure you want to proceed?", vbYesNo)
 If response = vbNo Then
 Exit Sub
 End If


Application.Run ("GetxlsxFiles")
Application.Run ("GetxlsFiles")

DataCopied = 1

Sheets("Instructions").Select

MsgBox "Completed Successfully"
End Sub

Sub GetxlsxFiles()
Dim Sheet As Worksheet
Path = Sheets("Instructions").Range("FileName").Value
Filename = Dir(Path & "*.xlsx")

Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True, Password:="Password"
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=Workbooks("RSModel.xlsm").Sheets("Current KPIs")
Next Sheet

Workbooks(Filename).Close saveChanges:=False
Filename = Dir()
Loop

End Sub

.

DETXLSFILES SUB - это то же самое, что и выше, за исключением расширения файла.

Answer 1

Я переписал свой код и просто предоставляю комментарии там.
Там слишком много, чтобы вписаться в комментарии.

Вот генеракодицетагкод:

Это на самом деле краткое, если вы удалите комментарии, которые объясняют, что я сделал.

Sub GetxlsxFiles()
    Dim wb As Workbook, wbTemp As Workbook
    Dim Path As String, Filename As String ', masterWB As String
    Dim Sheet As Worksheet
    '~~> Assuming the path is correct
    Path = Sheets("Instructions").Range("FileName").Value
    '~~> Path should contain e.g. "C:\TestFolder\"
    Filename = Dir(Path & "*.xlsx")
    '~~> Assuming you are consolidating all sheets 
    '~~> in the workbook that contain the macro
    Set wb = ThisWorkbook
    '~~> If not, use the commented line below
    '~~> Take note that you do not include the file extension
    'Set wb = Workbooks("RSModel")
    '~~> Or you can also open it like this
    'masterWB = "C:\Foldername\RSModel.xlsm"
    'Set wb = Workbooks.Open(Filename:=masterWB, ReadOnly:=True)
    Do While Filename <> ""
        Set wbTemp = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True, _
                        Password:="Password")
        For Each Sheet In wbTemp.Sheets
            '~~> this adds the sheet after the last sheet in the target WB
            '~~> If you specifically want to add it after a specific sheet, 
            '~~> use the commented line
            Sheet.Copy After:=wb.Sheets(wb.Sheets.Count)
            'Sheet.Copy After:=wb.Sheets("Current KPIs")
        Next
        wbTemp.Close False
        Filename = Dir
    Loop

End Sub

.

Вот генеракодицетагкод:

Sub GetSheets()
    Application.ScreenUpdating = False
    Dim response As Integer
    response = MsgBox("This will take some time to run." & vbNewLine & _
               "Are you sure you want to proceed?", vbYesNo)
    '~~> execute IF in one line
    If response = vbNo Then Exit Sub
    '~~> No need to use Application.Run. Call the subs directly
    GetxlsxFiles
    GetxlsFiles
    '~~> Not sure what's this for so I commented it
    'DataCopied = 1
    '~~> If you want below sheet to be selected then
    ThisWorkbook.Sheets("Instructions").Select
    MsgBox "Completed Successfully", vbInformation
End Sub

.

Я думаю выше, должен быть близок к тому, что вы хотите.

Надеюсь, это поможет.