Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Скопировать определенные строки на другой лист - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Скопировать определенные строки на другой лист (Формулы/Formulas)
Скопировать определенные строки на другой лист
anofilis Дата: Среда, 20.07.2016, 10:45 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 20% ±

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


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

Автор - anofilis
Дата добавления - 20.07.2016 в 10:45
Manyasha Дата: Среда, 20.07.2016, 11:16 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 1589
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
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]
К сообщению приложен файл: -1.xlsb(88Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение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]

Автор - Manyasha
Дата добавления - 20.07.2016 в 11:16
anofilis Дата: Среда, 20.07.2016, 11:22 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Да спасибо Вам огромное,не ожидал так быстро,как здорово.что есть знающие люди,спасибо еще раз.
 
Ответить
СообщениеДа спасибо Вам огромное,не ожидал так быстро,как здорово.что есть знающие люди,спасибо еще раз.

Автор - anofilis
Дата добавления - 20.07.2016 в 11:22
anofilis Дата: Среда, 20.07.2016, 12:02 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Вылезла ошибка,надо собирать данные с листов только с названиями месяцев а он со всех листов тянет
 
Ответить
СообщениеВылезла ошибка,надо собирать данные с листов только с названиями месяцев а он со всех листов тянет

Автор - anofilis
Дата добавления - 20.07.2016 в 12:02
Manyasha Дата: Среда, 20.07.2016, 12:24 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 1589
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
anofilis, тогда вместо строки [vba]
Код
If sh.Name <> "контроль" Then
[/vba]напишите
[vba]
Код
If IsDate("1 " & sh.Name & " 0") Then
[/vba]


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеanofilis, тогда вместо строки [vba]
Код
If sh.Name <> "контроль" Then
[/vba]напишите
[vba]
Код
If IsDate("1 " & sh.Name & " 0") Then
[/vba]

Автор - Manyasha
Дата добавления - 20.07.2016 в 12:24
anofilis Дата: Среда, 20.07.2016, 12:47 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Спасибо помогло.
 
Ответить
СообщениеСпасибо помогло.

Автор - anofilis
Дата добавления - 20.07.2016 в 12:47
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Скопировать определенные строки на другой лист (Формулы/Formulas)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!