Получение данных из других рабочих книг - цель, которая не достигнута во вложенных

Question

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

Sub Update_Database()

Dim directory As String
Dim fileName As String

Application.ScreenUpdating = False

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

fileName = Dir(directory & "\", vbReadOnly)

Dim mwb As Workbook
Set mwb = Workbooks("OEE_Database_Final.xlsm")

Do While fileName <> ""
    On Error GoTo ProcExit
    With Workbooks.Open(fileName:=directory & "\" & fileName, UpdateLinks:=False, ReadOnly:=True)
        If (fileName = "NOM*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O9:Z290").Value = mwb.Sheets("Database").Range("O9:Z290")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "SZE*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O291:Z537").Value = mwb.Sheets("Database").Range("O291:Z537")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "VEC*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O538:Z600").Value = mwb.Sheets("Database").Range("O538:Z600")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "KAY*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O601:Z809").Value = mwb.Sheets("Database").Range("O601:Z809")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "BBL*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O810:Z952").Value = mwb.Sheets("Database").Range("O810:Z952")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "POG*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O953:Z1037").Value = mwb.Sheets("Database").Range("O953:Z1037")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "SC1*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O1038:Z1159").Value = mwb.Sheets("Database").Range("O1038:Z1159")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "SC2*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O1160:Z1200").Value = mwb.Sheets("Database").Range("O1160:Z1200")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "SLP*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O1201:Z1263").Value = mwb.Sheets("Database").Range("O1201:Z1263")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "UIT*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O1264:Z1348").Value = mwb.Sheets("Database").Range("O1264:Z1348")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "ANE*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O1349:Z1823").Value = mwb.Sheets("Database").Range("O1349:Z1823")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "HAL*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O1824:Z2077").Value = mwb.Sheets("Database").Range("O1824:Z2077")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "SHX*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O2078:Z2242").Value = mwb.Sheets("Database").Range("O2078:Z2242")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "BAY*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O2243:Z2415").Value = mwb.Sheets("Database").Range("O2243:Z2415")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "TAM*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O2416:Z2522").Value = mwb.Sheets("Database").Range("O2416:Z2522")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "PUC*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O2523:Z2607").Value = mwb.Sheets("Database").Range("O2523:Z2607")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "JOF*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O2608:Z2648").Value = mwb.Sheets("Database").Range("O2608:Z2648")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "MAV*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O2649:Z2945").Value = mwb.Sheets("Database").Range("O2649:Z2945")
            ActiveWorkbook.Close SaveChanges:=False
        End If
    End With
    fileName = Dir
Loop

Application.ScreenUpdating = True


ProcExit:
Exit Sub

End Sub

Answer 1

Учитывая фрагмент

With Workbooks.Open(fileName:=directory & "\" & fileName, UpdateLinks:=False, ReadOnly:=True)
    If (fileName = "NOM*.xlsx") Then
        ActiveWorkbook.Sheets("Database").Range("O9:Z290").Value = mwb.Sheets("Database").Range("O9:Z290")
        ActiveWorkbook.Close SaveChanges:=False
    End If
End With

вы открываете файл, записываете некоторые значения из mbw.Sheets("Database") в и затем закрываете только что измененный файл без сохранения .

Из вашего комментария кажется, что вы намерены сделать обратное:

Dim mwb As Workbook
Set mwb = Workbooks("OEE_Database_Final.xlsm")
Dim Ws As Worksheet
Set Ws = mwb.Sheets("Database")

Do While Filename <> ""
    On Error GoTo ProcExit
    With Workbooks.Open(Filename:=directory & "\" & Filename, UpdateLinks:=False, ReadOnly:=True)
        Select Case True
            Case Filename Like "NOM*.xlsx"
                Ws.Range("O9:Z290").Value = .Sheets("Database").Range("O9:Z290").Value
                .Close SaveChanges:=False
            Case Filename Like "SZE*.xlsx"
                ' Code for this case
            ' Other cases...
            Case Else
                ' Put code here that is executed if none of the previous names has been matched
                ' or remove 'Case Else' if you don't want anything to happen then
        End Select
    End With
    Filename = Dir
Loop

Несколько замечаний:

• Я реализовал предложение из ответа Шая Радо об использовании оператора Like в структуре Select Case
• Я назначил новую переменную Worksheet как таковуюSet Ws = mwb.Sheets("Database") - это сокращает строки и облегчает обращение к другому листу, если требования изменяются (одно изменение, а не ~ 20 изменений)
• Блок With теперь фактически используется в своих интересах.Когда вы делаете With Workbooks.Open, VBA предоставляет вам неявную ссылку на эту книгу.Поэтому нет необходимости ссылаться на ActiveWorkbook.Достаточно простого ..Также он устраняет эту хрупкую зависимость от наличия активной книги right в нужное время.(Представьте себе, что произойдет, если по какой-то причине ActiveWorkbook изменится на полпути в вашем макросе ... Не вероятный сценарий, я дам вам это.)

Answer 2

Вы можете немного "обмануть", чтобы избежать неприятностей с Select Case.

. Чтобы использовать Like с Select, вы используете Select Case True, а затем вкладываете свои сценарии, используя Like и подстановочный знак *.

код

With Workbooks.Open(Filename:=directory & "\" & Filename, UpdateLinks:=False, ReadOnly:=True)
    Select Case True
        Case Filename Like "NOM*.xlsx"

        Case Filename Like "SZE*.xlsx"

        Case Filename Like "VEC*.xlsx"

        Case Filename Like "KAY*.xlsx"

        Case Filename Like "BBL*.xlsx"

        ' put all other scenarios down here....


    End Select

End With

Примечание : если все ваши файлы, которые вы пытаетесь проверить, являются файлами Excelпоэтому вам не нужно добавлять расширение .xlsx, просто используйте NOM*, SZE* и т. д.