много книг - один макрос

[SaLoKiN]

Всем снова здравствуйте!
каждый день формируется несколько файлов *xls
каждая книга содержит макрос,который формирует таблицу и копирует ее в буфер.
после закрытия месяца, мне приходится собирать с 80 книг эту таблицу в одну. т.е.
-открываю книгу результат.
-открываю каждую из 80 книг
-жму на макрос RunMe()
-перехожу в книгу результат
-ставлю дату(содержится в заголовке)
-ctrl+V.
-след книга.
это порядком поднадоело...поэтому нужна помощь местных гуру -__-

з.ы. возможно тема избитая-преизбитая....но поиск положительных результатов не дал(
в архиве файл результат и один из 80 файлов. макрос RunMe() делает то что нужно...

натолкните на чего-нить ;-)

[EducatedFool]

Что требуется? Собрать данные в один файл?
Тогда можете приспособить этот макрос для своей задачи:
http://excelvba.ru/code/CombineFiles

каждая книга содержит макрос,который формирует таблицу и копирует ее в буфер

неправильный подход
если файлов много - не надо в них плодить одинаковые макросы
весь код должен быть в одном файле - тогда будет намного проще

[DiemonStar]

Создаете один макрос в личной книге для формирования таблицы, сохранения ее в отдельную книгу и заполнения итоговой книги. Или используете надстройку из предыдущего поста.

[SaLoKiN]

EducatedFool
как всегда все шикарно =)

  ' ==== переносим данные в наш файл (shb - кодовое имя листа, куда помещаем данные)
           shb.Range("a" & shb.Rows.Count).End(xlUp).Offset(1).Resize(, ra.Rows.Count).Value = _
            Application.WorksheetFunction.Transpose(ra.Value)

по идее мне просто нужно где-то здесь запускать макрос открытой книги и помещать результат в shb.
верно?

неправильный подход
если файлов много - не надо в них плодить одинаковые макросы
весь код должен быть в одном файле - тогда будет намного проще

так получилось потому что, раньше я открывал каждый файл. и выполнял в нем макрос.

[SaLoKiN]

вот че придумал, прикручу свою функцию, у которой будет возвращаемый параметр(кол-во строк).
ток вот чего:
по книге гуляем, массивы грузим,считаем. а на выгрузке не дает.
это связано с тем что файл открыт только для чтения?
если так, то возможно ли из функции возвращать массив?

Function RunMe(ByVal WB As Workbook) As Integer

Dim i As Long, S As Long, j As Long, iLastRow As Long, ii As Long
Dim a, b
Dim y As Integer, y1 As Integer

Application.ScreenUpdating = False

'загрузить массив а значениями А3 J96
With WB.Sheets("НТК 1 ")
iLastRow = .Cells(1, 1).End(xlDown).Row 'до первой пустой строки в А или ставь 98
a = .Range(.Cells(3, 1), .Cells(iLastRow, 12)) ' загрузили массив А3 J96
End With
' создали массив  B для результата
ReDim b(1 To UBound(a, 1), 1 To 12)

j = 1
For ii = 99 To 144 'грубая прявязка к адресу
'подгрузили условия
    With WB.Sheets("НТК 1 ")
        compared1 = .Cells(ii, 4) ' marshrut
        compared2 = .Cells(ii, 6) ' nomer avto
        compared4 = 1 ' svoi mashini zzz = PrinadAvto(72)
    End With
'начинаем поиск
    For i = 1 To UBound(a) '96
        If a(i, 8) = compared1 Then
            If PrinadAvto(a(i, 11), WB) = compared4 Then
                b(j, 1) = compared2 'nomer avto
' убрал копирование, чтбы не мешало смотреть
                 j = j + 1
            End If
        End If
    Next
Next
'после след строки выходит из процедуры. а нужна сортировка.  что делать?
WB.Worksheets("для l5").Range(Cells(3, 1), Cells(j + 2, 10)) = b

WB.Worksheets("для l5").Sort.SortFields.Clear
WB.Worksheets("для l5").Sort.SortFields.Add Key:=Range(Cells(3, 1), Cells(j + 1, 1)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'A
    WB.Worksheets("для l5").Sort.SortFields.Add Key:=Range(Cells(3, 3), Cells(j + 1, 3)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'C
    WB.Worksheets("для l5").Sort.SortFields.Add Key:=Range(Cells(3, 9), Cells(j + 1, 9)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'I
    With WB.Worksheets("для l5").Sort
        .SetRange Range(Cells(3, 1), Cells(j + 1, 10)) 'A I
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
RunMe = j + 2 ' вернул кол-во строк
    
   
  ' Range(Cells(3, 1), Cells(j + 1, 9)).Select
   ' Range(Cells(3, 1), Cells(j + 1, 9)).Copy
    
    
    'ThisWorkbook.ActiveSheet.Range(Cells(3, 1), Cells(j + 2, 10))

'MsgBox "ep baby"
        
End Function

вызываю вот так

Sub LoadDataFromWorkbooks()
....
yo = RunMe(WB)
            MsgBox yo

UPD
установил у открываемого файла ReanOnly=FALSE.
результат тот-же...
доходит до строчки с выгрузкой и выбрасывает из функции. хелп?
поймал ошибку:
Application-defined or object-defined error
судя по всему я опять обращаюсь не к тому диапазону
WB.Worksheets("для l5").Range(Cells(3, 1), Cells(j + 2, 10)) = b
>Range опять куда попало у мя лезет?

[Hugo121]

WB.Worksheets("для l5").Range(Cells(3, 1), Cells(j + 2, 10)) = b

Обычная ошибка. Чьи Cells?

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

[SaLoKiN]

Обычная ошибка

точки надо?

[Hugo121]

Можно точки, чтоб буквы сэкономить:

with WB.Worksheets("для l5")
.Range(.Cells(3, 1), .Cells(j + 2, 10)) = b
end with

[SaLoKiN]

блин какой раз на эти грабли натыкаюсь!
пора бы мне уже запомнить это) спасибо!