Запуск кода на все файлы из папки, работает только для одного - PullRequest
0 голосов
/ 23 мая 2019

Я хотел бы запустить этот код для всех файлов из определенной папки. Этот код работает штрафов из одного файла.

Кто-нибудь может мне помочь?

Sub SplitWorkbook()
    Dim ws As Worksheet
    Dim DisplayStatusBar As Boolean
    DisplayStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Sheets
        Dim NewFileName As String
        Application.StatusBar = ThisWorkbook.Sheets.Count & _
                                " Remaining Sheets"
        If ThisWorkbook.Sheets.Count <> 1 Then
            NewFileName = ThisWorkbook.Path & "\" & ws.Name & ".xlsm" _
                          'Macro-Enabled
            ' NewFileName = ThisWorkbook.Path & "\" & ws.Name & ".xlsx" _
            'Not Macro-Enabled
            ws.Copy
            ActiveWorkbook.Sheets(1).Name = "Sheet1"
            ActiveWorkbook.SaveAs Filename:=NewFileName, _
                                  FileFormat:=xlOpenXMLWorkbookMacroEnabled
            ' ActiveWorkbook.SaveAs Filename:=NewFileName, _
            FileFormat:=xlOpenXMLWorkbook
            ActiveWorkbook.Close SaveChanges:=False
        Else
            NewFileName = ThisWorkbook.Path & "\" & ws.Name & ".xlsm"
            ' NewFileName = ThisWorkbook.Path & "\" & ws.Name & ".xlsx"
            ws.Name = "Sheet1"
        End If
    Next
    Application.DisplayAlerts = True
    Application.StatusBar = False
    Application.DisplayStatusBar = DisplayStatusBar
    Application.ScreenUpdating = True
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...