Вывести массив данных, собранных из файла, на конкретный лист в книге «Мастер»

Следующий код открывает выбранные файлы по одному за раз; если файл содержит определенную текстовую строку в B11 (существует четыре варианта: LS2A, LS1PRA, LS1A и LSM12), указанные данные из листа (1) каждого файла копируются в массив. Поиск выполняется функцией «SearchFor», которая вызывается в основной процедуре.

Массив ArrCopy заполняется данными из каждого файла и должен выводиться на один из четырех листов в основной книге (SABI, SABII, LSM или LPRI и II). Выходной лист определяется текстовой строкой в B11 каждого файла.

По какой-то причине я не могу получить данные для вывода в мастер-книгу. Я пробовал Debug.Print каждый элемент массива после его заполнения, и я вижу, что массив заполнен правильными данными, но я не могу заставить значения переходить к основной книге. Код запускается, но на листе ничего не выводится.

Пожалуйста, предложите, как это сделать. благодаря

  Option Explicit Function SearchFor(output As Worksheet) Dim rowsCount As Long Dim NCBead1 As Long, NCBead2 As Long, PCBead1 As Long, PCBead2 As Long Dim IniString As String, IniVar As String Dim rngCell As Range, rngCell2 As Range Dim ArrCopy(1 To 9) As Variant Dim LastRow As Long Dim aCell As Range LastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row 'extract initial after last underscore IniString = ActiveWorkbook.Sheets(1).Range("B6").Value IniVar = Right(IniString, Len(IniString) - InStrRev(IniString, "_", , 1)) Debug.Print IniVar 'Debug.Print "LastRow = " & LastRow Set aCell = ActiveSheet.Range("B1:B" & LastRow).Find(What:="Trimmed Mean", LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) 'Debug.Print "Trimmed Mean can be found in Row # " & aCell.Row 'wb.Sheets(1).Select For Each rngCell In ActiveSheet.Range("B" & aCell.Row & ":B" & LastRow) If InStr(rngCell, "NC") > 0 Then Debug.Print rngCell.Row NCBead1 = rngCell.Offset(0, 1).Value NCBead2 = rngCell.Offset(0, 2).Value 'End If Exit For End If Next rngCell For Each rngCell2 In ActiveSheet.Range("B" & aCell.Row & ":B" & LastRow) If InStr(rngCell2, "PC") > 0 Then Debug.Print rngCell2.Row PCBead1 = rngCell2.Offset(0, 1).Value PCBead2 = rngCell2.Offset(0, 2).Value 'End If Exit For End If Next rngCell2 'Next searched Debug.Print NCBead2 ArrCopy(1) = ActiveSheet.Range("B3").Value ArrCopy(2) = IniVar ArrCopy(3) = NCBead1 ArrCopy(4) = NCBead2 ArrCopy(5) = PCBead1 ArrCopy(6) = PCBead2 ArrCopy(7) = ActiveSheet.Range("B6").Value ArrCopy(8) = NCBead1 ArrCopy(9) = NCBead1 ' one row spanning several columns Debug.Print "ArrCopy" & ArrCopy(1) Debug.Print "ArrCopy" & ArrCopy(2) Debug.Print "ArrCopy" & ArrCopy(3) Dim Destination As Range Set Destination = output.Range("A" & output.Range("A" & Rows.Count).End(xlUp).Row + 1) Set Destination = Destination.Resize(1, UBound(ArrCopy)) Destination.Value = ArrCopy End Function Sub openselectedfiles() Dim SaveDriveDir As String, MyPath As String, FnameInLoop As String Dim mybook As Workbook, thisWb As Workbook Dim N As Long, LstUnderSc As Long, ExtPer As Long, Varin As Long Dim Fname As Variant, ArrCopy(1 To 9) As Variant Dim output As Worksheet Dim inLS2A As Boolean, inLS1PRA As Boolean, inLS1A As Boolean, inLSM12 As Boolean Set thisWb = ThisWorkbook ' Save the current directory. SaveDriveDir = CurDir ' Set the path to the folder that you want to open. MyPath = Application.DefaultFilePath ' Change drive/directory to MyPath. ChDrive MyPath ChDir MyPath ' Open GetOpenFilename with the file filters. Fname = Application.GetOpenFilename( _ FileFilter:="CSV Files (*.csv),*.csv", _ Title:="Select a file or files", _ MultiSelect:=True) ' Perform some action with the files you selected. If IsArray(Fname) Then With Application .ScreenUpdating = False .EnableEvents = False End With For N = LBound(Fname) To UBound(Fname) ' Get only the file name and test to see if it is open. FnameInLoop = Right(Fname(N), Len(Fname(N)) - InStrRev(Fname(N), Application.PathSeparator, , 1)) If bIsBookOpen(FnameInLoop) = False Then Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(Fname(N)) On Error GoTo 0 If Not mybook Is Nothing Then mybook.Sheets(1).Select With ActiveSheet.Range("B11") inLS2A = InStr(1, .Value, "LS2A", 1) > 0 inLS1PRA = InStr(1, .Value, "LS1PRA", 1) > 0 inLS1A = InStr(1, .Value, "LS1A", 1) > 0 inLSM12 = InStr(1, .Value, "LSM12", 1) > 0 End With If inLS2A Then Set output = thisWb.Sheets("SABII") SearchFor output ElseIf inLS1PRA Then Set output = thisWb.Sheets("LPRI&II") SearchFor output ElseIf inLS1A Then Set output = thisWb.Sheets("sabI") SearchFor output ElseIf inLSM12 Then Set output = thisWb.Sheets("LSM") SearchFor output End If 'End If mybook.Close SaveChanges:=False Set mybook = Nothing End If Else MsgBox "We skipped this file : " & Fname(N) & " because it is already open." End If Next N With Application .ScreenUpdating = True .EnableEvents = True End With End If ' Change drive/directory back to SaveDriveDir. ChDrive SaveDriveDir ChDir SaveDriveDir End Sub Function bIsBookOpen(ByRef szBookName As String) As Boolean ' Contributed by Rob Bovey On Error Resume Next bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing) End Function 

Interesting Posts

Excel VBA – месяц в формате «мммм»

Доступ к VBA -> Автоматический импорт таблицы Excel с помощью HYPERLINKS

Excel VBA макрос не найден на листе, #NAME

Отформатируйте диапазон ячеек как разблокированный, если другая ячейка имеет значение «x»,

Excel находит все, где col b = x

Задача потока данных с переменным источником

Сортировка сводной таблицы VBA

Несоответствие типов данных в выражении критериев при запросе файла excel с использованием vbscript

Преобразование пути общих папок к пути UNC

Отображать сообщение, когда ячейка пуста

Получить индекс ячейки из значения ячейки, Apache POI

Получение значений ячеек из Excel API C #

Ошибка выполнения 1004 выбор метода класса диапазона не удалось в Workbooks.Open

Получить ближайшую дату, основанную на сопоставлении критериев mutiple в Excel

Пытается создать цикл, который перемещает строки на другой лист на основе значения ячейки

Давайте будем гением компьютера.