Скопировать определенные строки на другой лист

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по Excel » Скопировать определенные строки на другой лист (Формулы/Formulas)

anofilis

Дата: Среда, 20.07.2016, 10:45 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 39

Репутация: 0 ±

Замечаний: 20% ±

Excel 2010

Добрый день. Друзья Вы как-то мне очень здорово помогли и вот решил вновь обратиться к Вам за помощью.Суть проблемы: есть файл(прикрепил) в котором ведется база по выполняемым заявкам на листах с названиями месяцев, нужно как-то реализовать возможность копирования строк с актуального месяца(листы соответственно будут добавляться на каждый месяц) на лист "контроль", копировать надо строки индекс которых в столбике "А" равен 2 и более.Друзья спасибо заранее, буду очень признателен за помощь.

К сообщению приложен файл: __.xlsm (93.8 Kb)

Сообщение отредактировал anofilis - Среда, 20.07.2016, 10:53

Ответить

Manyasha

Дата: Среда, 20.07.2016, 11:16 | Сообщение № 2

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 898 ±

Замечаний: 0% ±

Excel 2010, 2016

anofilis, здравствуйте, так пойдет?
[vba]

Код

Sub macro()
    With Application: .ScreenUpdating = False: .EnableEvents = False: End With
    Dim sh, lr&, i&, j&
    j = 2
    Sheets("контроль").Cells(2, 1).Resize(Sheets("контроль").Cells(Rows.Count, 1).End(xlUp).Row, 10).Clear
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "контроль" Then
            With sh
                lr = .Cells(Rows.Count, 1).End(xlUp).Row
                For i = 3 To lr
                    If IsNumeric(.Cells(i, 1)) And .Cells(i, 1) > 1 Then
                        Sheets("контроль").Cells(j, 1).Resize(, 10).Value = .Cells(i, 1).Resize(, 10).Value
                        .Cells(i, 1).Resize(, 10).Copy
                        Sheets("контроль").Cells(j, 1).Resize(, 10).PasteSpecial xlPasteFormats
                        j = j + 1
                    End If
                Next i
            End With
        End If
    Next sh
    With Application: .ScreenUpdating = True: .EnableEvents = True: End With
End Sub

[/vba]