Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub GetSheets()
- Dim WriteRow As Long, _
- LastCell As Range, _
- WbDest As Workbook, _
- WbSrc As Workbook, _
- WsDest As Worksheet, _
- WsSrc As Worksheet
- Set WbDest = ThisWorkbook
- Set WsDest = WbDest.Sheets.Add
- WsDest.Cells(1, 1) = "Шапку сюда!"
- Path = "C:\Users\User\Desktop\Пример объединения таблиц из разных файлов\"
- Filename = Dir(Path & "*.xls")
- Do While Filename <> ""
- Set WbSrc = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
- Set WsSrc = WbSrc.Sheets(1)
- With WsSrc
- Set LastCell = .Cells.Find(What:="*", _
- After:=.Range("A1"), _
- Lookat:=xlPart, _
- LookIn:=xlFormulas, _
- SearchOrder:=xlByRows, _
- SearchDirection:=xlPrevious, _
- MatchCase:=False)
- .Range(.Range("A2"), LastCell).Copy
- End With
- With WsDest
- WriteRow = .Cells.Find(What:="*", _
- After:=.Range("A1"), _
- Lookat:=xlPart, _
- LookIn:=xlFormulas, _
- SearchOrder:=xlByRows, _
- SearchDirection:=xlPrevious, _
- MatchCase:=False).Row + 1
- '.Range("A" & WriteRow).Paste
- 'OR
- .Range("A" & WriteRow).PasteSpecial
- End With
- '''To clear clipboard to avoid 'large clipboard' warnings on close
- Application.CutCopyMode = False
- WbSrc.Close
- Filename = Dir()
- Loop
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement