매크로는 오류없이 일찍 종료됩니다

Question

나는 아래의 코드를 사용하여 특정 폴더의 모든 통합 문서에서 한 통합 문서로 복사합니다.9 코드가 10 배로 작동하며 모든 데이터가 복사되지만 MSGBox가 표시되지 않으므로 마무리하지 않고 일찍 일찍 종료하는 것처럼 보입니다. 오류 메시지가 나타나지 않습니다.MACRO는 다른 매크로를 실행할 수있게 해주는 것처럼 종료 된 것으로 나타납니다.누구 든지이 일을 일으킬 수있는 것이 무엇인지 알려줄 수 있습니까?매크로가 실행되는 동안 컴퓨터에서 다른 일을 시작하기 시작하면 발생하는 것 같습니다.

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

.

getxlsfiles 하위는 파일 확장자를 제외하고는 위와 동일합니다.

Answer 1

코드를 다시 작성하고 저기에 의견을 제공하십시오.
의견에 맞는 것은 너무 많습니다.

여기 GetxlsxFiles Sub입니다 내가 한 일을 설명하는 의견을 제거하는 경우 실제로 간단합니다.

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

.

여기는 GetSheets 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

.

위에서 위에서 생각해보십시오. 이것이 도움이되기를 바랍니다.