Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Сборка данных с разных листов на один
 
Добрый вечер
Проблема вот в чем: есть три листа по 10 столбцов в каждом, каждый месяц меняется количество строк с данными на листах
Надо:
1. либо напечатать эти три листа на 1 листе, а если строк много то на двух на трех и т.д., но Excel печатает каждый лист на отдельном листе
2. либо собрать данные с трех листов на один и уже затем распечатать

Подскажите как можно решить проблему любым способом, т.к таких книг для печати около 100 каждый месяц появляется. Спасибо.
Изменено: barah - 24 Фев 2015 21:36:01
 
Для решения вопроса проблема в другом - Вы не прочитали правила этого форума, в частности - п.п.2.2, 2.3
 
Спасибо, что напомнили про файл, совсем про него забыл :(
 
Конкретно под Вашу таблицу вот такой макрос:
Код
Sub Copyr()
Dim WSS
Dim Rw, Rw1 As Long
WSS = Split("Лист1 Лист2 Лист3")
Worksheets("Общий лист").Activate
Range(Cells(7, 1), Cells(Cells(Rows.Count, 8).Rows.End(xlUp).Row, 10)).Value = Empty
Rw = 1
For Each WS In WSS
    Worksheets(WS).Activate
    Rw1 = Cells(Rows.Count, 8).Rows.End(xlUp).Row
    Range(Cells(8, 1), Cells(Rw1, 10)).Copy
    Worksheets("Общий лист").Select
    ActiveSheet.Paste Destination:=Range(Cells(Rw, 1), Cells(Rw, 1))
    Rw = Rw + Rw1 - 5
Next WS
End Sub
Единственное, все страницы надо сделать одинаковыми: начинать ввод данных с 8-й строки, "Итог" размещать в 8 колонке...
 
Можете изменить макрос так, чтобы вставлялись не формулы а только значения?
Изменено: barah - 27 Фев 2015 20:26:14
 
barah, пожалуйста. Кроме того теперь информация копируется с произвольного количества листов с любыми названиями (кром, естесственно,
"Общий лист" ) на лист, который, соответственно, называется
"Общий лист" ;)
Код
Sub Copyr()
Dim Rw, Rw1 As Long
Rw = 1
Worksheets("Общий лист").Activate
Range(Cells(7, 1), Cells(Cells(Rows.Count, 8).Rows.End(xlUp).Row, 10)).Value = Empty
For Each WS In Worksheets
    WS.Activate
    If WS.Name <> "Общий лист" Then
        Rw1 = Cells(Rows.Count, 8).Rows.End(xlUp).Row
        Range(Cells(8, 1), Cells(Rw1, 10)).Copy
        Worksheets("Общий лист").Select
        Cells(Rw, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Rw = Rw + Rw1 - 5
    End If
Next WS
End Sub
 
МВТ, Спасибо все получилось :)
Страницы: 1
Читают тему (гостей: 1)