Сводная таблица из нескольких листов

[4uvak111]

С массивом строк разобрался, оказалось не так уж и трудно, заодно и функции интересные нашел lbound и ubound

Sub Макрос1()

Cells.Select
Selection.Clear
Range("A1").Select
Dim X, y, w, i
Dim strFileToOpen
Dim wrkBook As Workbook
Dim User()
ReDim User(1 To 3)

User(1) = "us1": User(2) = "us2": User(3) = "us3"

w = 1

For i = LBound(User) To UBound(User)
X = 1: y = 1
strfile = "C:\Сводная книга\" & User(i) & "\лист.xlsx"
Set wrkBook = Workbooks.Open(strfile)
Do While Cells(X, y).Value <> ""
' Переносим Значение из 1.xls в текущую книгу (с макросом)
ThisWorkbook.Worksheets("Лист1").Cells(w, y).Value = _
                wrkBook.Worksheets("Лист1").Cells(X, y).Value
y = y + 1
If y > 2 Then
X = X + 1: w = w + 1: y = 1:
End If
Loop
wrkBook.Close
Next i

Set wrkBook = Nothing

End Sub

[Hugo121]

1. Зачем копируете ячейки по-одной? Сразу всем диапазоном будет быстрее - можно копировать (Copy), можно приравнивать значения, можно через массив.
2. Зачем 3 раза повторять код? Можно перебирать в цикле файлы или массив с именами нужных файлов.
3. bBookOpen определяет, не открыта ли книга у Вас. Используйте такой код:

Function IsOpen(sFileName As string) As Boolean
Dim FN%
FN = FreeFile
On Error Resume Next
Open sFileName For Random Access Read Write Lock Read Write As #FN
Close #FN
IsOpen = Err
End Function

P.S. Пока писал, п2 уже решился. Хорошо...
Но как-то сложно Вы usы перебираете...

Sub tt()
    Dim a
    For Each a In Split("us1 us2 us3")
        MsgBox a
    Next
End Sub

или

Sub ttt()
    Dim a
    For Each a In Array("us1", "us2", "us3")
        MsgBox a
    Next
End Sub

[4uvak111]

Hugo121, просто первый рабочий код, на который наткнулся - работал именно так, копируя по одной ячейке. В принципе, можно копировать и по строке, и по диапазону - главное знать сколько строк и какой диапазон (количество строк будет постепенно добавляться).

С пунктом 2 разобрался, да, даже неожиданно быстро для себя.
Ну а Ваш код по пункту 3 буду внедрять завтра - сегодня уже засыпаю, спасибо большое за код.
Правильно понимаю, что проверка по данной функции должна выполнятся следующим образом?

If IsOpen("FileName")=false Then
<оператор, выполняется если файл закрыт и доступен для копирования данных>
End If

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

[Hugo121]

Он просто покажет, свободен ли файл. А дальше уже как сделаете - можно например вывестить msgbox и после его закрытия снова повторить попытку. Т.е. увидели сообщение - кричите чтоб закрыли файл и затем жмёте ОК. Или просто тупо повторять раз в секунду проверять файл.
Ну а просто взять данные думаю можно с помощью формул - т.е. забиваете кодом в ячейки формулы, потом меняете на значения.
Ну или можно попробовать открывать файл с помощью GetObject() - но я точно не знаю, как там с занятыми файлами...

[4uvak111]

И все таки, как считывать информацию из открытых файлов?

И еще, как записать изменяющийся путь? Т.е. чтобы вместо "C:\book\list.xls" можно было написать %Текущая_папка%\list.xls ?

[4uvak111]

А как складывать время - ч:мм:сс?