Копирование определенных именованных листов в рабочую книгу из всех файлов в папке

Question

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

Я не уверен в своем понимании высказываний «ЕСЛИ». Если я выполняю свой код шаг за шагом с точкой останова на endif, я получаю желаемый результат, то есть каждый рабочий лист, названный в каждом операторе IF, из каждого файла в моей папке, но если я запускаю его нормально, мой код будет только пройти через первый оператор IF и затем переключить файл. Я получу первый лист каждого файла в моей папке.

Может кто-нибудь посоветовать мне решение для этого?

Кстати, я знаю, что могу делать операторы IF в одном цикле FOR, я просто пытался следовать ему шаг за шагом, прежде чем работать над циклом. Я также попытался установить время ожидания на случай, если ошибка была во время открытия файла или чего-то еще, но это не выглядит так.

Sub Import_Files()

Dim MyFolder As String, MyFile As String

With Application.FileDialog(msoFileDialogFolderPicker)
   .AllowMultiSelect = False
   .Show
   MyFolder = .SelectedItems(1)
   Err.Clear
End With

'stops screen updating, calculations, events, and status bar updates to help code run faster
'It'll be opening and closing many files so this will prevent the screen from displaying that

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

'This section will loop through and open each file in the folder selected
'and then close that file before opening the next file

Set sThisBk = ActiveWorkbook
MyFile = Dir(MyFolder & "\", vbNormal)

Do While MyFile <> ""
    DoEvents
    'On Error GoTo 0
    Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False
    'Application.Wait (Now + TimeValue("0:00:15"))
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If SheetExists("ANALYSE E 000002") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000002")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000003") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000003")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000004") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000004")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000005") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000005")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000006") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000006")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000007") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000007")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000008") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000008")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000009") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000009")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000010") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000010")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000011") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000011")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000012") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000012")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000002") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000002")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000003") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000003")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000004") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000004")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000005") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000005")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000006") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000006")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000007") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000007")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000008") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000008")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000009") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000009")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000010") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000010")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000011") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000011")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000012") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000012")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '0
    Workbooks(MyFile).Close SaveChanges:=False
    MyFile = Dir
Loop

'turns settings back on that was turned off before looping folders

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationManual

End Sub


Private Function SheetExists(sWSName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True
End Function

Answer 1

Основная проблема в том, что ваша функция SheetExists не знает, в какой книге нужно искать.Поэтому для просмотра книги необходим параметр.

Private Function SheetExists(ByVal SheetName As String, Optional InWorkbook As Workbook) As Boolean
    Dim sht As Object

    If InWorkbook Is Nothing Then Set InWorkbook = ThisWorkbook 'default to ThisWorkbook 

    On Error Resume Next
    Set sht = InWorkbook.Sheets(SheetName)
    SheetExists = Not sht Is Nothing
    On Error Goto 0 'either this or Err.Clear is needed
End Function

Затем я рекомендую определить список имен листов, которые следует скопировать, чтобы можно было использовать цикл:

Dim ListOfSheetNames As Variant
ListOfSheetNames = Array("ANALYSE E 000002", "ANALYSE E 000003") 'add more sheet names here

Затем установите открытую рабочую книгу в переменную для более легкого доступа:

Dim OpenedWorkbook As Workbook
Set OpenedWorkbook = Workbooks.Open(Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False)

И, наконец, прокрутите список имен листов, проверьте, существуют ли имена листов в открытой книге, и скопируйте его в ThisWorkbook(это рабочая книга, в которой выполняется этот код).

Dim SheetName As Variant
For Each SheetName In ListOfSheetNames 'loop through all sheet names in the list
    If SheetExists(SheetName, OpenedWorkbook) Then 'test if sheet name exists in the opened workbook
        OpenedWorkbook.Sheets(SheetName).Copy Before:=ThisWorkbook.Sheets("ENDOFFILE")
    End If
Next SheetName

В конце вы можете закрыть открытую рабочую книгу с помощью

OpenedWorkbook.Close SaveChanges:=False