Работа с несколькими книгами excel vba

Хитрости »

1 Май 2011              765637 просмотров


Как собрать данные с нескольких листов или книг?

Очень часто бывает необходимо собрать данные с нескольких листов одной книги или даже с листов нескольких книг. Например, каждую неделю мы получаем некие отчеты от отделов, которые необходимо собрать в одну общую таблицу для построения сводной таблицы. Или это могут быть некие книги прайсов по товарам от разных поставщиком, который опять же надо сначала объединить, а потом уже анализировать. Вручную делать это довольно муторно. И то, муторно это только для первых 20-ти листов/файлов, потом становится просто тошно. Поэтому решил поделиться решением, которое поможет собрать данные со всех листов книги, со всех листов всех указанных книг или только с указанных листов:

'---------------------------------------------------------------------------------------
' Author : Щербаков Дмитрий(The_Prist)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          https://www.excel-vba.ru
'          info@excel-vba.ru
'          WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' Purpose: http://www.excel-vba.ru/chto-umeet-excel/kak-sobrat-dannye-s-neskolkix-listov-ili-knig/
'             Процедура сбора данных с нескольки листов/книг
'---------------------------------------------------------------------------------------
Option Explicit
 
Sub Consolidated_Range_of_Books_and_Sheets()
    Dim iBeginRange As Range, rCopy As Range, lCalc As Long, lCol As Long
    Dim oAwb As String, sCopyAddress As String, sSheetName As String
    Dim lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
    Dim wsSh As Worksheet, wsDataSheet As Worksheet, bPolyBooks As Boolean, avFiles
    Dim wbAct As Workbook
    Dim bPasteValues As Boolean, IsPasteSheetName As Boolean
 
    On Error Resume Next
    'Выбираем диапазон выборки с книг
    Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _
                                           "1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _
                                           vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)
    'для указания диапазона без диалогового окна:
    'Set iBeginRange = Range("A1:A10") 'диапазон указывается нужный
    'Если диапазон не выбран - завершаем процедуру
    If iBeginRange Is Nothing Then
        Exit Sub
    End If
    'Указываем имя листа
    'Допустимо указывать в имени листа символы подставки ? и *.
    'Если указать только * то данные будут собираться со всех листов
    sSheetName = InputBox("Введите имя листа, с которого собирать данные(если не указан, то данные собираются со всех листов)", "Параметр")
    'Если имя листа не указано - данные будут собраны со вех листов
    If sSheetName = "" Then
        sSheetName = "*"
    End If
    'добавлять ли имя листа в начало таблицы
    IsPasteSheetName = (MsgBox("Вставлять имя листа первым столбцом?", vbQuestion + vbYesNo, "www.wxcel-vba.ru") = vbYes)
    On Error GoTo 0
    'Запрос - вставлять на результирующий лист все данные
    'или только значения ячеек (без формул и форматов)
    bPasteValues = (MsgBox("Вставлять только значения?", vbQuestion + vbYesNo, "www.wxcel-vba.ru") = vbYes)
    'Запрос сбора данных с книг(если Нет - то сбор идет с активной книги)
    If MsgBox("Собрать данные с нескольких книг?", vbInformation + vbYesNo, "www.wxcel-vba.ru") = vbYes Then
        avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)
        If VarType(avFiles) = vbBoolean Then Exit Sub
        bPolyBooks = True
        lCol = 1
    Else
        avFiles = Array(ThisWorkbook.FullName)
    End If
    If IsPasteSheetName Then
        lCol = lCol + 1
    End If
    'отключаем обновление экрана, автопересчет формул и отслеживание событий
    'для скорости выполнения кода и для избежания ошибок, если в книгах есть иные коды
    With Application
        lCalc = .Calculation
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlManual
    End With
    'создаем новый лист в книге для сбора
    Set wsDataSheet = ActiveWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
    'если нужно сделать сбор данных на новый лист книги с кодом
    'Set wsDataSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    'цикл по книгам
    For li = LBound(avFiles) To UBound(avFiles)
        If bPolyBooks Then
            Set wbAct = Workbooks.Open(Filename:=avFiles(li))
        Else
            Set wbAct = ThisWorkbook
        End If
        oAwb = wbAct.Name
        'цикл по листам
        For Each wsSh In wbAct.Sheets
            If wsSh.Name Like sSheetName Then
                'Если имя листа совпадает с именем листа, в который собираем данные
                'и сбор идет только с активной книги - то переходим к следующему листу
                If wsSh.Name = wsDataSheet.Name And bPolyBooks = False Then GoTo NEXT_
                With wsSh
                    Select Case iBeginRange.Count
                    Case 1 'собираем данные начиная с указанной ячейки и до конца данных
                        lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row
                        iLastColumn = .Cells.SpecialCells(xlLastCell).Column
                        sCopyAddress = .Range(.Cells(iBeginRange.Row, iBeginRange.Column), .Cells(lLastrow, iLastColumn)).Address
                    Case Else 'собираем данные с фиксированного диапазона
                        sCopyAddress = iBeginRange.Address
                    End Select
                    lLastRowMyBook = wsDataSheet.Cells.SpecialCells(xlLastCell).Row + 1
                    'определяем для копирования диапазон только заполненных данных на листе
                    Set rCopy = Intersect(.Range(sCopyAddress).Parent.UsedRange, .Range(sCopyAddress))
                    'вставляем имя книги, с которой собраны данные
                    If lCol > 0 Then
                        If bPolyBooks Then
                            wsDataSheet.Cells(lLastRowMyBook, 1).Resize(rCopy.Rows.Count).Value = oAwb
                        End If
                        If IsPasteSheetName Then
                            wsDataSheet.Cells(lLastRowMyBook, lCol).Resize(rCopy.Rows.Count).Value = .Name
                        End If
                    End If
                    'если вставляем только значения
                    If bPasteValues Then
                        rCopy.Copy
                        wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol).PasteSpecial xlPasteValues
                        wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol).PasteSpecial xlPasteFormats
                    Else 'если вставляем все данные ячеек(формулы, форматы и т.д.)
                        rCopy.Copy wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol)
                    End If
                End With
            End If
NEXT_:
        Next wsSh
        If bPolyBooks Then
            wbAct.Close False
        End If
    Next li
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = lCalc
    End With
End Sub

Приведенный выше код необходимо вставить в стандартный модуль(Что такое модуль? Какие бывают модули?). Выполнить его можно будет из этой книги нажатием клавиш Alt+F8. В появившемся окне выбрать Consolidated_Range_of_Books_and_Sheets и нажать Выполнить. Так же можно создать на листе кнопку и назначить ей данный макрос. Так же, если впервые работаете с макросами настоятельно рекомендую прочитать статью: Что такое макрос и где его искать?, а так же Почему не работает макрос?

После вызова макроса поочередно будут появляется запросы, в которых надо будет указать исходные параметры:

  • Диапазон сбора данных — Если в окне выбора диапазона выбрать только одну ячейку, то данные будут собраны со всех листов книги/книг, начиная с этой ячейки и до последней ячейки листа.
    Если выбрать несколько ячеек, данные будут собраны только с указанного диапазона всех листов книги/книг. Допускается указать несвязанный(рваный) диапазон(например, только три столбца: A:A,D:D,F:F). Сделать это можно, выделив нужный диапазон с зажатой клавишей Ctrl. Здесь необходимо учитывать, что Excel позволяет одним махом скопировать не любые рваные диапазоны, а только диапазоны одного размера и только если они начинаются с одной строки. Например, если выделить диапазоны A1:B20, F1:H20 — они будут скопированы без проблем. Но если попробовать указать диапазоны со сдвигом: A1:B20, F2:H21 — Excel выдаст ошибку.
  • Имя листа — Необязателен для указания. Если не указан — данные будут собраны со всех листов. Указать можно как точное соответствие имени листа, так и с частичным соответствием. Например, если в книгах для сбора данных необходимо собрать данные только с листа «Январь», то следует так и указать — «Январь». Если требуется собрать данные только с листов, начинающихся с «Продажи»(«Продажи ЮГ», «Продажи НН», «Продажи Запад» и т.д.), то следует применить символ подстановки звездочку — «Продажи*». Если надо собрать с листов, содержащих в имени «продажи»(«Итоговые продажи ЮГ», «Продажи НН», «Сезонные продажи» и т.д.), то указываем «*продажи*». Если надо собрать только с листа «Сезонные продажи», но известно, что вместо пробела может быть нижнее подчеркивание или тире(«Сезонные продажи», «Сезонные_продажи», «Сезонные-продажи») или иной символ, то можно также применить звездочку — «Сезонные*продажи». Но если среди листов могут встречаться и такие как «Сезонные разовые продажи», «Сезонные корпоративные продажи» и т.п., но информацию с них собирать не надо, то можно применить вопросительный знак — «Сезонные?продажи». Вопросительный знак заменяет любой один символ, звездочка — любое количество любых символов.
  • Вставлять имя листа первым столбцом? — если выбрать Да, перед данными в итоговой таблице будут записаны имена листов, с которых были собраны данные. Если будет указано собирать данные с нескольких книг — то имя листа будет во втором столбце, если с листов одной книги — то имя листа будет первым столбцом.
  • Вставлять только значения? — если выбрать Да, то в результирующий лист с листов будут вставлены исключительно значения ячеек (без формул), но при этом сохранятся их форматы(формат чисел, цвет заливки, цвет шрифта, границы и т.п.). Может пригодится, если на листах для сбора записаны формулы, ссылающиеся на другие листы, книги, диапазоны. При обычном копировании может случиться так, что формула выдаст ошибку, т.к. в книге для вставки нет таких листов и диапазонов или данные расположены иначе. Если выбрать Нет, то все ячейки с листов на результирующий будут копироваться в точности как в исходных листах.
  • И последний запрос: Собрать данные с нескольких книг? — если выбрать Да, то появится диалоговое окно выбора файлов. Надо указать все файлы, данные с которых необходимо собрать. Если выбрать Нет, то данные будут собираться с листов только активной книги. При этом, если выбран вариант сбора с нескольких книг, то первым столбцом в итоговой таблице будут записаны имена файлов, с которых были собраны данные

Данные будут собраны на новый лист книги с макросом. Если данные собирались с нескольких книг, то в первый столбец будут занесены имена книг, с которых собраны данные.

Если после сбора данных обнаружили, что после каждого файла/листа много пустых строк, то следует найти в коде строку:

lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row

и заменить её на строку примерно следующего содержания:

lLastrow = .Cells(.Rows.Count, 1).End(xlUp).Row

где 1 — это номер столбца на листах данных, в котором искать последнюю заполненную ячейку.
Актуально это для файлов с одинаковой структурой. Например, если сбор идет с листов по продажам, то вполне может быть такое, что в столбце 1 может не быть данных. Поэтому следует определить номер столбца, в котором наполнение данных максимально. Например, это может быть столбец с наименованиями товара или с суммами. Если это столбец D, то следует строку записать так:

lLastrow = .Cells(.Rows.Count, 4).End(xlUp).Row 'ищем последнюю строку в 4-м столбце

Подробнее про определение последней строки можно прочитать в статье: Как определить последнюю ячейку на листе через VBA?

Важное замечание: Если вы используете Excel 2007 и выше и файлы для сбора данных тоже в этом формате, то следует скачанный файл сначала сохранить в формат «Книга Excel с поддержкой макросов(.xlsm)», закрыть и открыть заново. Иначе есть шанс получить ошибку при сборе данных, т.к. Excel будет в режиме совместимости и не сможет поместить на результирующий лист более 65536 строк.

Скачать пример:

  Сбор данных с листов и книг.xls (73,0 KiB, 37 091 скачиваний)

Также см.:
Сбор данных с нескольких листов/книг
Как объединить несколько текстовых файлов в один?
Просмотреть все файлы в папке
План-фактный анализ в Excel при помощи Power Query


Статья помогла? Поделись ссылкой с друзьями!

  Плейлист   Видеоуроки


Поиск по меткам



Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика

Студворк — интернет-сервис помощи студентам

У меня 2 книги, нужно из одной ячейки первой книги перенести содержимое во вторую книгу в опр. ячейки.
Как я себе это представляю. Открываю 1ю книгу, ищу инфу, пихаю это все в переменные, открываю вторую книгу и записываю все туда.
Как открыть 2ю книгу и сделать ее активной? Получается открыть сам файл, но выполнить процедуру Workbooks(path).Activate я не могу. Посмотрите что не так, в бейсике работаю 1й раз.

Можно ли вообще работать с двумя открытыми книгами одновременно? Или нужно будет открыть и запомнить все из 1й книги, открыть 2ю и записать все туда?

Вот код:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub Тест()
 
' sPRG - 1я книга
' sPAS - 2я книга
 
sPRG = "! Перечень Котельных Саратов.xls"       'имя файла программы
Workbooks(sPRG).Activate                        'активирую 1ю книгу
Sheets("25. Анализ котельных ").Select          'активирую нужный лист
tekDIR = Workbooks(sPRG).Path + ""             'текущая директория
 
N = 22
objNUM = Cells(N, 51)
K = Cells(N, 3) + " - " + Cells(N, 4) + " " + Cells(N, 5)   'заношу все в переменные
 
sPAS = tekDIR + Cells(N, 50) + "Энергопаспорт " + Cells(N, 4) + ".xls" 'путь 2й книги
 
'Set q = Workbooks.Open(sPAS)
'Workbooks.Open (sPAS)
Workbooks.Open Filename:=sPAS                   'открываю сам файл
 
'Workbooks(sPAS).Activate                       'ВОТ ЭТО НЕ РАБОТАЕТ! (книга 2)
 
 
Cells(6, 2) = "zzz"                             'запись в книгу 2
 
K = Workbooks(sPRG).Sheets("25. Анализ котельных").Cells(N, 2) 'чтение из книги 1 тоже перестало работать, почему?
 
Cells(7, 2) = K
 
End Sub
 

Exo

Пользователь

Сообщений: 14
Регистрация: 18.06.2018

#1

22.08.2018 11:07:38

Код
Sub Open_file()      'Макрос открытия файла
    Dim A As Integer
    A = 1
    If A < 38 Then
    FilePath = Sheets("Адреса").Cells(A, 1) 'Забираем полный путь к файлу из ячейки
    Workbooks.Open Filename:=FilePath  'Открываем фаил
    A = A + 1
    End If
End Sub

Не срабатывает оператор IF.
Имеется фаил со списком полных адресов до файлов которые нужно открыть.
принцип который закладывал вовремя написания файла.
переменная А изначально ровна 1.
Если А меньше 38 то берем адрес файла из ячейке 1,1 первое значение установлено переменной.
после открытия файла значение переменной увеличиваем на один. и открываем вторую строку первого столбца. Но почему то открыв первый фаил макрос останавливается.

Прикрепленные файлы

  • По часовая выработка день.xlsm (129.19 КБ)

 

Alemox

Пользователь

Сообщений: 2183
Регистрация: 25.02.2013

#2

22.08.2018 11:15:35

Потому что у вас нет цикла. Поэтому после открытия одного файла макрос останавливается.

Код
Sub Open_file()      'Макрос открытия файла
    Dim A As Integer
    A = 1
    Do while A < 38
    FilePath = Sheets("Адреса").Cells(A, 1) 'Забираем полный путь к файлу из ячейки
    Workbooks.Open Filename:=FilePath  'Открываем фаил
    A = A + 1
    loop
End Sub

Изменено: Alemox22.08.2018 11:26:28

Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.

 

БМВ

Модератор

Сообщений: 21385
Регистрация: 28.12.2016

Excel 2013, 2016

#3

22.08.2018 11:16:59

Цитата
Exo написал:
Но почему то открыв первый фаил макрос останавливается.

Может по тому что нет ни цикла, ни прочего что говорит коду о повторе операции.

И право придумать название теме отправляется  Alemox :-)

Изменено: БМВ22.08.2018 11:20:04

По вопросам из тем форума, личку не читаю.

 

SAS888

Пользователь

Сообщений: 757
Регистрация: 01.01.1970

#4

22.08.2018 11:24:38

Я бы добавил ссылку на книгу с этим макросом:

Код
Sub Open_file() 'Макрос открытия файла
    Dim i As Integer: Application.ScreenUpdating = False
    For i = 1 To 37
        Workbooks.Open ThisWorkbook.Sheets("Адреса").Cells(i, 1)
    Next
End Sub

Изменено: SAS88822.08.2018 11:25:32

Чем шире угол зрения, тем он тупее.

 

Exo

Пользователь

Сообщений: 14
Регистрация: 18.06.2018

#5

22.08.2018 11:25:13

Цитата
Alemox написал:
Потому что у вас нет цикла. Поэтому после открытия одного файла макрос останавливается.

Да вы правы. Я тоже понял что это оператор выбора. Сделал Do while но без then
вроде как синтаксис должен так выглядить. Но он выполнив один цикл возвращает ошибку Run time error.
Увидел ваш код и добавил Then но редактор стал ругаться на синтаксис(((

 

БМВ

Модератор

Сообщений: 21385
Регистрация: 28.12.2016

Excel 2013, 2016

#6

22.08.2018 11:28:18

Код
Sub Open_file() 'Макрос открытия файла
    Dim i As Integer: Application.ScreenUpdating = False
    For each WB in ThisWorkbook.Sheets("Адреса").Range("A1:A37")
        Workbooks.Open WB
    Next
End Sub

По вопросам из тем форума, личку не читаю.

 

Alemox

Пользователь

Сообщений: 2183
Регистрация: 25.02.2013

#7

22.08.2018 11:29:10

Цитата
Exo написал:
Then но редактор стал ругаться на синтаксис(((

Это опечатка. Then не нужен.
БМВ, вот Вы меня сейчас заставили мозг включить  :D
Тема: Как при помощи VBA открыть несколько книг Excel с условием.

Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.

 

БМВ

Модератор

Сообщений: 21385
Регистрация: 28.12.2016

Excel 2013, 2016

#8

22.08.2018 11:32:27

Цитата
Alemox написал:
мозг включить  

Пых, Пых :-)

По вопросам из тем форума, личку не читаю.

 

Exo

Пользователь

Сообщений: 14
Регистрация: 18.06.2018

 

Exo, Вам нужно иметь одновременно открытыми 37 файлов? Может быть, очередной файл надо закрыть перед открытием следующего?

 

Alemox

Пользователь

Сообщений: 2183
Регистрация: 25.02.2013

Казанский, а смысл открывать их тогда  :D

Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.

 

и изначально последовательно не открывались файл за файлом, потому, что макрос работает не так, как Вы себе задумали и представдяли что он будет работать, а работает так, как Вы его написали!

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 

ivanok_v2

Пользователь

Сообщений: 712
Регистрация: 19.08.2018

Alemox, Вам Казанский, задал правильный вопрос, как вы одновременно сможете работать с таким количеством файлов? это же пародия + нагрузка на ПК.

 

БМВ

Модератор

Сообщений: 21385
Регистрация: 28.12.2016

Excel 2013, 2016

ivanok_v2, ну конечно Казанский не Alemox вопрос задавал и конечно вопрос к ТС что они там делают, но предположить что нужна одновременная работа с несколькими открытыми книгами, например 37 магазинов или филиалов и консолидация при помощи формул, которые работают только с открытой книгой — можно. Ну а нагрузка на современный пк — более чем мизерная.

По вопросам из тем форума, личку не читаю.

 

Exo

Пользователь

Сообщений: 14
Регистрация: 18.06.2018

Вы правы открытыми их держать не нужно. Их нужно открыть и закрыть по одному. Но Я не хочу получить тут готовый код. У нас есть обходное решение. Это просто облегчит работу логистам склада. Я больше хочу обучится. Поэтому в первую очередь реализую открытие а после уже закрытие. Этот фаил я больше использую для обучения чем для решения производственных нужд.

 

Exo

Пользователь

Сообщений: 14
Регистрация: 18.06.2018

#16

23.08.2018 13:02:52

Код
Sub Open_file()      '?????? ???????? ?????
    Dim A As Integer
    A = 1
    Do While A < 37
    A = A + 1
    FilePath = Sheets("Адреса").Cells(A, 1) '???????? ?????? ???? ? ????? ?? ?????? A1 ?? ????? "????1"
    Workbooks.Open Filename:=FilePath  '???????? ?????
    Loop
    
End Sub

Почему то данный цикл отрабатывает лиш раз и останавливается. Хотя должен пройти 37 циклов. В чем проблема.
А скрипт который написал БМБ открывает 12 файлов после чего зависает.

Код
Sub Open_file() 'Макрос открытия файла
    Dim i As Integer: Application.ScreenUpdating = False
    For each WB in ThisWorkbook.Sheets("Адреса").Range("A1:A37")
        Workbooks.Open WB
    Next
End Sub

Изменено: Exo23.08.2018 13:05:54

 

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

У меня недавно был проект, где тоже нужно было работать с несколькими книгами. Я пошёл по следующему пути: циклом открывал книги, копировал нужный лист в файл с макросом, книги закрывал. А уже потом работал с листами — гораздо удобнее. После обработки (в самом конце макроса) эти листы удалял.

 

Exo

Пользователь

Сообщений: 14
Регистрация: 18.06.2018

У меня это делается формулами. Единственное после выкачки из WMS эти файлы нужно открыть для обновления связей.

Но почему я не могу запустить цикл. С точки зрения моей логики он должен работать. а он выходит из цикла после первой обработки.

Изменено: Exo23.08.2018 13:08:08

 

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

#19

23.08.2018 13:11:23

Цитата
Exo написал:
скрипт который написал БМБ открывает 12 файлов после чего зависает.

БМБ? ))
Все вопросы к медведю: может он название переменной перепутал — вместо BMW написал WB.

 

должно работать
но если не работает — есть на то причина

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 

Exo

Пользователь

Сообщений: 14
Регистрация: 18.06.2018

при втором цикле ругается на 6 строку.
Число в не диапазона.

Изменено: Exo23.08.2018 14:14:39

 

Alemox

Пользователь

Сообщений: 2183
Регистрация: 25.02.2013

#22

23.08.2018 23:01:58

Проверьте в адресном диапазоне правильно ли все пути и имена указаны, и существуют ли такие листы.
У меня код отрабатывает как положено

Код
Sub Open_file()      'Макрос открытия файла
    Dim A%, FilePath$
    A = 1
    Do While A < 37
    FilePath = ThisWorkbook.Worksheets("Адреса").Cells(A, 1) 'Забираем полный путь к файлу из ячейки
    Workbooks.Open Filename:=FilePath  'Открываем фаил
    A = A + 1
    Loop
End Sub

Изменено: Alemox23.08.2018 23:09:06

Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.

 

Exo

Пользователь

Сообщений: 14
Регистрация: 18.06.2018

#23

24.08.2018 14:04:51

Проблему решил. Тем что добавил закрытие файла. Если хотя бы один файл открыт макросом то он не работает далее.

If you’re looking to consolidate multiple Excel workbooks with minimal effort, you’ve come to the right place.

Laptop screen with code display

When working with varied data sources, you might often struggle to compile multiple workbooks and worksheets before arriving at one final data piece. Imagine a situation where you have a few hundred workbooks to combine before you can even begin your day.

No one wants to spend endless hours working on different sources, opening each workbook, copying and pasting the data from various sheets, before finally making one consolidated workbook. What if a VBA macro can do this for you?

With this guide, you can create your own Excel VBA macro code to consolidate multiple workbooks, all in a matter of minutes (if the data files are a lot).

Pre-Requisites for Creating Your Own VBA Macro Code

You need one workbook to house the VBA code, while the rest of the source data workbooks are separate. Additionally, create one workbook Consolidated to store the consolidated data from all your workbooks.

Create a folder Consolidation at your preferred location to store all your source workbooks. When the macro runs, it would toggle through each workbook stored within this folder, copy the contents from various sheets, and place it in the Consolidated workbook.

Creating Your Own Excel VBA Code

Once the pre-requisites are out of the way, it is time to delve into the code and start hacking away at the basics to adapt it to your requirements.

Press the Alt+F11 key on Excel to open the VBA macro code editor. Paste the code written below and save the file as a Macro enabled workbook (.xlsm extension).

  Sub openfiles()'declare the variables used within the VBA codeDim MyFolder As String, MyFile As String, wbmain As Workbook, lastrow As Long'disable these functions to enhance code processingWith Application.DisplayAlerts = False.ScreenUpdating = FalseEnd With'change the path of the folder where your files are going to be savedMyFolder = InputBox("Enter path of the Consolidation folder") & ""'define the reference of the folder in a macro variableMyFile = Dir(MyFolder)'open a loop to cycle through each individual workbook stored in the folderDo While Len(MyFile) > 0'activate the Consolidation workbookWindows("Consolidation").Activate'calculate the last populated rowRange("a1048576").SelectSelection.End(xlUp).SelectActiveCell.Offset(1, 0).Select'open the first workbook within the Consolidation folderWorkbooks.Open Filename:=MyFolder & MyFileWindows(MyFile).Activate'toggle through each sheet within the workbooks to copy the dataDim ws As WorksheetFor Each ws In Sheets ws.Activate ws.AutoFilterMode = False 'ignore the header and copy the data from row 2 If Cells(2, 1) = "" Then GoTo 1 GoTo 101: Next10: Range("a2:az20000").CopyWindows("Consolidation").Activate'paste the copied contentsActiveSheet.PasteWindows(MyFile).Activate'close the open workbook once the data is pastedActiveWorkbook.Close'empty the cache to store the value of the next workbookMyFile = Dir()'open the next file in the folderLoop'enable the disabled functions for future useWith Application.DisplayAlerts = True.ScreenUpdating = TrueEnd WithEnd Sub 

The VBA Code Explained

The first part of the code is defining a subroutine, which holds all your VBA code. Define the subroutine with sub, followed by the name of the code. The sub name can be anything; ideally, you should keep a name relevant to the code you are about to write.

Excel VBA understands user-created variables and their corresponding data types declared with dim (dimension).

To enhance the processing speed of your code, you can turn off screen updating and suppress all alerts, as that slows down the code execution.

The user will be prompted for the path of the folder where the data files are stored. A loop is created to open each workbook stored within the folder, copy the data from each sheet, and append it to the Consolidation workbook.

Excel VBA code snippet

The Consolidation workbook is activated so that Excel VBA can calculate the last populated row. The last cell within the worksheet is selected, and the last row is calculated within the workbook using the offset function. This is highly useful, when the macro starts appending data from the source files.

As the loop opens the first source file, the filters are removed from every single sheet (if they exist), and the data ranging from A2 to AZ20000 will be copied and pasted into the Consolidation workbook.

The process is repeated until all the workbook sheets are appended within the master workbook.

Finally, the source file is closed once all the data is pasted. The next workbook is opened so that the VBA macro can repeat the same steps for the next set of files.

Excel VBA code snippet

The loop is coded to run till all the files are automatically updated in the master workbook.

User-Based Customizations

Sometimes, you don’t want to worry about inbuilt prompts, especially, if you are the end-user. If you would rather hardcode the path of the Consolidation folder in the code, you can change this part of the code:

  MyFolder = InputBox("Enter path of the Consolidation folder") & "" 

To:

  MyFolder = &ldquo;Folder path&rdquo; & "" 

Additionally, you can also change the column references, as the step is not included in this code. Just replace the end column reference with your last populated column value (AZ, in this case). You need to remember that the last populated row is calculated via the macro code, so you need to change the column reference only.

To make the most out of this macro, you can use it only to consolidate workbooks in the same format. If the structures are different, you can’t use this VBA macro.

Consolidating Multiple Workbooks Using Excel VBA Macro

Creating and modifying an Excel VBA code is relatively easy, especially if you understand some of the nuances within the code. VBA systematically runs through each code line and executes it line by line.

If you make any changes to the code, you must ensure you don’t change the order of the codes, as that will disrupt the code’s execution.

Модератор:Naeel Maqsudov

6667

Сообщения:3
Зарегистрирован:06 окт 2010, 19:50

Здравствуйте. Кто может подсказать где можно найти информацию по работе с двумя книгами одновременно? В частности различные способы переноса необходимой информации с одной книги в другую средствами VBA.
У меня такая ситуация. Имеется две книги:
1) Одна называется «Журнал работ». В первом листе вносятся данные о работе сотрудников за каждый день(Дата, ФИО сотрудника, номер работы и т.д)([ATTACH]1812[/ATTACH] ). Во втором листе «Отчет» формируется сводная таблица по фамилии сотрудника и по номеру работы ( [ATTACH]1814[/ATTACH]).
2) Во второй книге «По зарплате» так же хранится та же таблица что и на листе «Отчет», только с дополнительными строками, столбцами и вычислениями. На нем произносится расчет по зарплате на основе этой таблицы.
[ATTACH]1813[/ATTACH]

Мне необходимо создать в книге «По зарплате» процедуру, которая сформирует отчет в книге «Журнал работ» по определенному месяцу и перенесет данные в книгу «По зарплате»

Пытался это реализовать с помощью массива, но не получилось перенести сформированный массив обратно в книгу «По зарплате».
Так же пробовал с банальным копированием диапазона(Range) из одной книги в другую, но в связи с тем что структура отчетов по каким либо причинам могут меняться, мне данный метод не подошел, т.к при копировании нужные данные могут затираться

Дошел до варианта подстановки листов с разных книг в процедуре листа «Отчет»(книга Журнал работ), но с этим возникла сложность. Не знаю как вместо названия листа (допустим «Sheets(«Отчет»)») использовать переменную, в которую при необходимости будет присваиваться нужный лист

У вас нет необходимых прав для просмотра вложений в этом сообщении.

Аватара пользователя

Naeel Maqsudov

Сообщения:2551
Зарегистрирован:20 фев 2004, 19:17
Откуда:Moscow, Russia
Контактная информация:

15 ноя 2013, 16:19

Попробуйте для начала вообще отказаться от переноса данных
1) делайте всё одной книге или
2) используйте в формулах внешние ссылки

Непонятно, как формируется отчёт, сводными таблицами (тогда, кстати, сводная таблица могла бы брать данные из другой книги по внешней ссылке), или макросом?
Если сейчас отчёт у вас формируется макросом, и Вам непременно надо, чтобы вторая книга была отдельным документом, то просто «допилите» макрос формирующий отчёт, пусть он кладёт данные сразу в обе книги.

Не существует никаких

различных способов переноса необходимой информации с одной книги в другую средствами VBA

. Всё что работает в одной книге, работает и между книгами. См. коллекцию Application.Workbooks

6667

Сообщения:3
Зарегистрирован:06 окт 2010, 19:50

15 ноя 2013, 17:16

У меня нет возможности использовать все в одной книге, т.к эти книги располагаются на разных локальных компьютерах разными сотрудниками, а из этого соответственно для каждого доступна только конкретная информация.
Где можно подробно узнать о коллекции Application.Workbooks?
Какого типа должна быть переменная чтобы к ней присвоить Sheets(«Журнал работ») и в дальнейшем допустим использовать.К примеру:

Dim LBook as ???
LBook = Sheets(«Журнал работ»)
…………………….
LBook.Cells(1,1).Value = 1

Где то уже видел подобный пример, но не могу вспомнить как она реализовывалась.

Аватара пользователя

Naeel Maqsudov

Сообщения:2551
Зарегистрирован:20 фев 2004, 19:17
Откуда:Moscow, Russia
Контактная информация:

15 ноя 2013, 17:45

Подробнее про коллекцию
1) в справке по VBA (опционально устанавливается вместе с офисом)
2) в Object Borowser, который вызывается по F2 в VBA-редакторе, можно видеть все классы с из свойствами и методами. Именно здесь можно быстро познакомиться с объектной моделью офисного приложения.

Скажите, а есть ли у вас какой-нибудь корпоративный файл-сервер, где файлы можно было бы расшарить между всеми участниками бизнес-процесса?
Ведь для копирования данных вы же всё равно на одной из этих рабочих станций таки берёте и открываете оба файла одновременно.

Ну а раз так, то любой макрос может

1) делать Workbooks.Open(…)
3) Workbooks(«Другой файл»).WorkSheets(«Журнал работ»).Cells(1,1).Value = 123
2) Workbooks(«Другой файл»).Close(…)

PS
А макрос для составления отчёта Вы сами писали?
Если нет, то может обратиться к разработчику, чтобы доделал?

6667

Сообщения:3
Зарегистрирован:06 окт 2010, 19:50

15 ноя 2013, 23:52

Полностью всю программу я писал сам, так что помощи не от кого ждать, да и не интересно так

Коллекции объектов

Ссылка на объект коллекции — это название коллекции, после которого в скобках указывается индекс объекта или его имя в кавычках. Например, ссылка Workbooks(1) выбирает первую из открытых рабочих книг, а Workbooks(«budget») ссылается на рабочую книгу с именем «budget».

Важно

  • Количество элементов коллекции заранее не фиксируется.
  • Новый элемент может быть добавлен в произвольное место коллекции.
  • Элементы коллекции перенумеровываются при удалении или добавлении элементов в коллекцию.
  • Различные коллекции объектов имеют общие методы и свойства, но параметры вызова методов могут различаться.

Объекты Workbooks и Workbook

Документ MS Excel (рабочая книга) это объект Workbook. Можно одновременно работать с несколькими рабочими книгами. Открытые рабочие книги составляют коллекцию рабочих книгWorkbooks.

Свойство Workbooks объекта Application возвращает объект Workbooks.

При открытии или создании рабочей книги элемент Workbook автоматически добавляется в конец коллекции Workbooks, а при закрытии книги соответствующий элемент также автоматически удаляется из коллекции.

Некоторые свойства и методы объектов Workbooks и Workbook

Свойства и методы Примеры операторов и комментарии
Объект Workbooks
Свойство Count (R/O Long) MsgBox «Число открытых рабочих книг » & Workbooks.Count высвечивает число рабочих книг в коллекции
Метод Add Workbooks.Add добавляет новую рабочую книгу в коллекцию
Метод Close Workbooks.Close используется без аргументов и закрывает все рабочие книги
Объект Workbook
Свойство Colors Свойство, заданное с индексом, указывает на конкретный элемент палитры. ActiveWorkbook.Colors(5) = RGB(255,0,0) заменяет пятый цвет палитры на красный
Свойство без индекса возвращает палитру цветов в виде массива из 56 цветов.

ActiveWorkbook.Colors = WorkbooksAIR.XLS»).Colors заменяет палитру активной книги на палитру цветов книги AIR.XLS.

Свойство Name (R/O String) MsgBox Workbooks(Workbooks.Count).Name высвечивает имя последней открытой книги
Свойство FullName (R/O String) MsgBox ActiveWorkbook.FullName возвращает полное имя активной рабочей книги, включая путь к ней
Свойство Sheets ThisWorkbook.Sheets.Count возвращает количество элементов в коллекции листов различных типов рабочей книги, содержащей выполняемый код
Свойство Charts ActiveWorkbook.Charts(1).Name возвращает имя первого листа в коллекции диаграммных листов активной книги
Свойство Worksheets Workbooks(1).Worksheets(1).Activate активизирует первый лист из коллекции рабочих листов
Метод Open Workbooks.Open «AIR.xls» открывает существующую рабочую книгу AIR.xls
Метод Close ActiveWorkbook.Close SaveChanges:=True, FilenameAIR« закрывает рабочую книгу. Книга удаляется из коллекции, и элементы коллекции Workbooks перенумеровываются.

Параметр SaveChanges сохраняет или отменяет сделанные изменения. Параметр Filename задает название новой рабочей книги

Метод Activate WorkbooksAIR.XLS»).Activate активизирует указанную рабочую книгу
Метод SaveAs ActiveWorkbook.SaveAs FileName:=»d:bel_accfirst_book» сохраняет рабочую книгу под именем Filename. Если в Filename папка не указана, то файл сохраняется в текущей папке
Событийные процедуры

Событийные процедуры записываются на процедурном листе, связанном с объектом. Каждый объект имеет свои собственные события.

Чтобы вставить событийную процедуру для объекта Workbook

  • выделите объект ThisWorkbook (Эта книга) в окне проекта;
  • перейдите на лист процедур, нажав клавишу F7. Можно выполнить команду View Code или сделать двойной щелчок на объект ThisWorkbook ;
  • на процедурном листе в окне выбора объектов (вверху слева) выберите объект Workbook ;
  • в окне выбора событий (вверху справа) выберите событие. Автоматически вставляется процедура со стандартным именем, которое состоит из названия объекта и названия события, разделенных нижним подчеркиванием (_), например, для события Open событийная процедура имеет имя Workbook_Open ;
  • запишите текст процедуры.

Пример

При вставке нового листа в рабочую книгу процедура запрашивает имя нового листа и вставляет лист в начало рабочей книги.

При выборе события NewSheet автоматически появляется новая процедура Workbook_NewSheet с параметром Sh.

Значение параметра, являющееся ссылкой на объект — новый лист, передается процедуре во время ее выполнения. Метод Move перемещает вставленный лист. Параметр before этого метода определяет новое месторасположение листа — начало рабочей книги.

Объекты Sheets, WorkSheets и WorkSheet

Коллекция Sheets представляет собой совокупность листов различных типов — рабочих листов (коллекция Worksheets ) и листов диаграмм (коллекция Charts ). Таким образом, каждый элемент коллекции Sheets является элементом коллекции WorkSheets или коллекции Charts и наоборот, любой элемент коллекции WorkSheets или коллекции Charts принадлежит коллекции Sheets.

Некоторые свойства и методы объектов Sheets, WorkSheets и WorkSheet

Свойства и методы Примеры и комментарии
Объекты Sheets, WorkSheets
Свойство Count (R/O Long) MsgBox «Количество рабочих листов в активной книге » & ActiveWorkbook.WorkSheets.Count высвечивает количество рабочих листов в рабочей книге
Метод Add Sheets.Add, WorkSheets.Add добавляет новый лист заданного типа в рабочую книгу
Объекты Sheets, WorkSheets, Sheet, WorkSheet
Методы Copy, Move Копирует, перемещает указанные листы или группу листов в новое место. Worksheets(1).Move after:=Worksheets(Worksheets.Count) перемещает первый лист в конец рабочей книги
Объекты Sheet, WorkSheet
Метод Activate WorkSheets(«January»).Activate активизирует указанный рабочий лист
Метод Delete ActiveWorkbook.Worksheets(1).Delete удаляет первый рабочий лист
Свойство Name (R/W String) Возвращает или устанавливает имя листа. WorkSheets(WorkSheets.Count).Name =»LastSheet» переименовывает последний рабочий лист
Объекты WorkSheet
Свойство Columns (R/O) Возвращает коллекцию столбцов. Worksheets(1).Columns(1).Font.Bold = True устанавливает полужирный шрифт для первой колонки первого рабочего листа
Свойство ScrollArea (R/W String) Определяет границы интервала, внутри которого возможно перемещение по ячейкам. При установке значения «пустая строка» доступны все ячейки рабочего листа. Worksheets(1).ScrollArea = «A1:F10» разрешает доступ только к ячейкам A1:F10
Свойство Shapes (R/O) Возвращает коллекцию Shapes — коллекцию графических объектов рабочего листа: рисунки, автофигуры и т.д. ActiveSheet.Shapes(1).AutoShapeType = 21 меняет тип первого графического объекта активного листа на «сердечко»
Свойство Rows(R/O) Возвращает коллекцию строк. Worksheets(«Sheet1»).Rows(3).Delete удаляет третью строку
Метод Calculate ActiveWorksheet.Calculate производит вычисления во всех ячейках указанного рабочего листа
Метод CheckSpelling Используется для проверки правописания (с аргуменами и без аргументов). ActiveSheet.CheckSpelling ignoreUppercase:= True не проверяет слова, записанные только прописными буквами
Методы
Метод Add

Добавляет новый лист в коллекцию Sheets, WorkSheets. При создании рабочей книги коллекция WorkSheets содержит столько рабочих листов, сколько определено свойством SheetsInNewWorkbook объекта Application.

Внимание

  • Метод Add для объектов Workbooks и Sheets имеет различный синтаксис.

Cинтаксис метода для коллекций Sheets, WorkSheets

expression.Add([Before] [,After] [,Count] [,Type])
  • expression — выражение, возвращающее коллекцию WorkSheets или Sheets. Указание обязательно;
  • Before 1Возможно задание только одного из двух параметров Before или After
    — специфицирует лист, перед которым вставляется новый лист;
  • After 2Возможно задание только одного из двух параметров Before или After
    — специфицирует лист, после которого вставляется новый лист;
  • Count — количество вставляемых листов;
  • Type — тип вставляемого листа. Используются константы: xlWorksheet (по умолчанию), xlChart (только для объекта Sheets ), xlExcel4MacroSheet, xlExcel4IntlMacroSheet.

Важно

  • При отсутствии всех параметров один рабочий лист добавляется перед активным листом.
  • При задании параметров Before и After указывается ссылка на лист как индекс или имя в коллекции листов, например, Sheets(1) или Sheets(«Лист1»)
Методы Move и Select

Метод Move используется для перемещения листов.

Синтаксис expression.Move([Before] [,After])

  • expression — ссылка на объект, представляющий перемещаемый лист. Указание обязательно;
  • необязательные параметры before и after (ссылки на лист, см. описание метода Add ) определяют новое местоположение перемещаемого листа. Если не указан ни один из параметров, то лист перемещается во вновь создаваемую рабочую книгу.

Метод Select выделяет объект. При применении к одному листу методы Activate и Select активизируют указанный лист. Но метод Select используется для группировки листов, т.е. для расширения выделения.

Синтаксис expression.Select([Replace])

  • expression — ссылка на объект, представляющий выделяемый лист. Указание обязательно;
  • Replace — для расширения выделения аргумент устанавливается в False. Если аргумент не задан или принимает значение True, то вместо старой области выделения создается новая область выделения. Необязательный параметр.

Замечание

  • Для выделения листов с конкретными именами используйте функцию Array. Например, Sheets(Array(«Лист8», «Лист12»)).Select.

Пример

Процедура перемещает нечетные листы в конец рабочей книги. В цикле выделяются нечетные листы.

Событийные процедуры

Чтобы вставить событийную процедуру для объекта WorkSheet:

  • выделите объект WorkSheet (например, Лист1 ) в окне проекта;
  • перейдите на лист процедур этого объекта;
  • на процедурном листе в окне объектов (вверху слева) выберите объект WorkSheet ;
  • в окне выбора событий (вверху справа) выберите событие;
  • запишите текст процедуры.

При выборе события автоматически вставляется процедура со стандартным именем, которое состоит из названия листа и названия события, разделенных нижним подчеркиванием (_).

Пример

При активизации листа Лист1 в ячейку A1 заноситcя название листа.

Пример работы с событийной процедурой объекта WorkSheet

Рис.
8.8.
Пример работы с событийной процедурой объекта WorkSheet

Объект Range

При работе в MS Excel чаще всего выполняются некоторые действия с группой ячеек рабочего листа. Объект Range — это отдельная ячейка, целиком строка или столбец рабочего листа, выделенный интервал ячеек, непрерывный интервал ячеек или интервал несмежных ячеек.

Для задания объекта Range существуют различные возможности. Например, благодаря свойству ActiveCell, активная ячейка представляется в качестве объекта Range. Свойство Selection определяет выделенный интервал ячеек в качестве объекта Range.

Свойства и методы, возвращающие объект Range

Свойства и методы Применимы к объектам Примеры и комментарии
Свойство ActiveCell Application Оператор ActiveCell.Value=10 устанавливает значение активной ячейки равным 10
Свойство Areas Range Оператор Range(«A1, B5:B10, C12:C20»).Areas(3).Value = 10 устанавливает значение 10 для третьей области объекта Range — для ячеек интервала C12:C20
Свойство Cells Application, Range, Worksheet Оператор Cells(7,3).Select активизирует ячейку C7 и равносилен оператору Range(«C7»).Select
Свойство Columns Application, Range, Worksheet Оператор Columns(«A:D»).Select выделяет первые четыре столбца
Свойство CurrentRegion Range Оператор ActiveCell.CurrentRegion.Count подсчитывает количество ячеек с данными в интервале, окружающем активную ячейку
Свойство Offset Range Операторы Range («A2:B10»).Select, Selection.Offset(2,2).Value=10 устанавливают значение 10 каждой ячейки интервала C4:D12.

Равносильно записи Range(«C4:D12»).Value=10

Свойство Range Application, Range, Worksheet Операторы p=Range(«A:B»).Count, p=Range(«налог»).Count, p=ActiveSheet.Range(«A1:A10«).Count, p=Range(«1:3»).Count, p=Range(«A1:C2, B10:D24″).Count присваивают переменной p количество ячеек в заданных интервалах
Свойство Rows Application, Range, Worksheet Оператор Rows(«1:3»).Select выделяет первые три строки
Свойство Selection Application Оператор Selection.Clear очищает выделенный интервал ячеек
Метод Union Range Union(Range(«A1:C5»), Range(«B10:D12») объединяет два несмежных интервала в один объект Range

ЗАМЕЧАНИЯ

  • Все перечисленные свойства возвращают объект Range, не активизируя новую ячейку.
  • Ячейка остается активной до тех пор, пока методы Activate или Select не активизируют новую ячейку.

Добрый день, помогите пожалуйста решить проблему.

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

В общем проблема возникла как обратиться к книге. Вернее к книге, которую нужно открыть я обратился так:

Создал переменную, скопировал в нее значение из справочника (это путь с названием файла, он большой — \enterpriseomegaПапки отделовАдминистративный департаментОтдел транспортной логистикитранспортОтчетыОтчеты по прозвону водителейИтоговыйПрозвонВодителей.xlsm)

[vba]

Код

Dim a As String
a = Worksheets(«Справочник»).Cells(i, 55).Value

Dim objWorkbook As Excel.Workbook
Set objWorkbook = Workbooks.Open(Filename:=a)

[/vba]

Теперь возник вопрос как обратиться к книге, из которой запустил макрос?
Ведь если я использую ActiveWorkbook, то обращаюсь к книге, которую открыл предыдущей командой.

Команда [vba]

Код

Workbooks(b).Sheets(«Аналитика»).Cells(c, 3).Value

[/vba], где b — путь к файлу и само название файла — не помогает.

Прошу помощи.
[moder]Нарушение п.3 Правил в части тегов. Исправил и отзамечовывал.

Понравилась статья? Поделить с друзьями:

А вот еще интересные статьи:

  • Работа с несколькими документами excel
  • Работа с программой excel для начинающих видео уроки бесплатно
  • Работа с непечатаемыми символами в word
  • Работа с программой excel ввод формул
  • Работа с неизвестными в excel

  • 0 0 голоса
    Рейтинг статьи
    Подписаться
    Уведомить о
    guest

    0 комментариев
    Старые
    Новые Популярные
    Межтекстовые Отзывы
    Посмотреть все комментарии