Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сборка данных с разных листов на один
 
#1
24.02.2015 21:18:59
Добрый вечер
Проблема вот в чем: есть три листа по 10 столбцов в каждом, каждый месяц меняется количество строк с данными на листах
Надо:
1. либо напечатать эти три листа на 1 листе, а если строк много то на двух на трех и т.д., но Excel печатает каждый лист на отдельном листе
2. либо собрать данные с трех листов на один и уже затем распечатать

Подскажите как можно решить проблему любым способом, т.к таких книг для печати около 100 каждый месяц появляется. Спасибо.
Изменено: barah - 24.02.2015 21:36:01
 
 
 
#2
24.02.2015 21:21:02
Для решения вопроса проблема в другом - Вы не прочитали правила этого форума, в частности - п.п.2.2, 2.3
 
 
 
#3
24.02.2015 21:48:46
Спасибо, что напомнили про файл, совсем про него забыл :(
 
 
 
#4
24.02.2015 23:06:02
Конкретно под Вашу таблицу вот такой макрос:
Код
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 колонке...
 
 
 
#5
25.02.2015 09:18:55
Можете изменить макрос так, чтобы вставлялись не формулы а только значения?
Изменено: barah - 27.02.2015 20:26:14
 
 
 
#6
26.02.2015 20:39:38
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
 
 
 
#7
27.02.2015 15:00:33
МВТ, Спасибо все получилось :)
 
 
 
Страницы: 1
Наверх