Так работает с закрытыми книгами.
Код |
---|
Sub ИзЗакрытыхКниг()
Dim wb1 As Workbook
Dim wb2 As Workbook: Set wb2 = Workbooks.Add
Dim col As Collection
Set col = New Collection
col.Add Array("C:\tmp\Пример файла.xlsx", "Sheet1", "A1:Z100")
col.Add Array("C:\tmp\Пример файла.xlsx", "Лист1", "A1:Z100")
Dim x As Long
Dim i As Long
Dim a As Variant
Dim r As Range
Dim c As Range
Dim v As Variant
x = 1
For Each v In col
On Error Resume Next
Set wb1 = Nothing
Set wb1 = Workbooks.Open(v(LBound(v)), False, True)
Set r = Nothing
Set r = wb1.Sheets(v(LBound(v) + 1)).Range(v(LBound(v) + 2)).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not r Is Nothing Then
ReDim a(1 To r.Cells.Count)
i = 1
For Each c In r
a(i) = c.Value
i = i + 1
Next
If x + UBound(a) > Columns.Count Then Exit For
wb2.Sheets(1).Cells(1, x).Resize(1, UBound(a)) = a
x = x + UBound(a)
Erase a
End If
On Error Resume Next
wb1.Close False
On Error GoTo 0
Next
End Sub
|