Копирование строк из нескольких Листов по условию на Лист этой же Книги

[Mutarix]

Добрый день,
Нужна ваша помощь для реализации, думаю не сложной, задачи.
Стандартными средствами Excel задача не решается. Нужно сделать макрос. К сожалению моих знаний не хватает.

Во вложенном файле шаблон, который содержат материал для реализации задачи.
Есть рабочие листы Пост1, Пост2, Пост3, Пост4 которые постоянно наполняются информацией. На основании этой информации нужно сделать отчёты: Бюджет (отдельный лист) и Груз в пути (отдельный лист).

     1) Бюджет формируется по следующим критериям:
Указываем диапазон даты пример: от 01,11,14 и до 30,11,14, после нажатия кнопки "загрузить" на лист Бюджет копируются строки (если есть возможность определенные ячейки в этих строках) Дата оплаты которых попадает в этот диапазон. Из каждого листа Пост1, Пост2, Пост3, Пост4 последовательно вставляются на Лист Бюджет.

     2) Груз в пути формируется по следующему условию:
Указываем дату, на которую нужно определить груз в пути после нажатия кнопки "загрузить" применяем условие отбора строк. Все строки, которые: Дата загрузки < ("Дата")< Дата прихода пример: 15.10.2014<("01.11.2014")<15.11.14.
Из каждого листа Пост1, Пост2, Пост3, Пост4 последовательно копируются строки (если есть возможность определенные ячейки в этих строках) на Лист Груз в пути.

Заранее благодарю за любую помощь!

[vikttur]

Здесь помогли:
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=60967&TITLE_SEO=60967-kopirovanie-strok-iz-neskolkikh-listov-po-usloviyu-na-list-etoy-zhe-knigi

[Mutarix]

Как посмотреть код.

[Mutarix]

Решение найдено!!!
После адаптации предложенных вариантов к рабочей среде, было выявлены проблемы работы программы.
Цикл поиска прерывался, если в ячейке попадалось значение: "#Н/Д" и #ЗНАЧ!
Программа была доработана:

Код Выделить Развернуть

Sub Budget()

Application.ScreenUpdating = False
Set ShtA = ThisWorkbook.Worksheets("Бюджет")
ShtA.Range("A4:G" & WorksheetFunction.Max(4, ShtA.Cells(ShtA.Rows.Count, 1).End(xlUp).Row)).Value = ""
DateA = Cells(5, 9).Value
DateB = Cells(5, 11).Value
B = 3

For Each ShtX In ThisWorkbook.Worksheets
    With ShtX
        If .Name <> "Груз в пути" And .Name <> "Бюджет" Then
            C = .Cells(.Rows.Count, 1).End(xlUp).Row
            If C > 6 Then
                For A = 6 To C
               [b] If IsError(.Cells(A, 31).Value) Then[/b]               
                    [b]Else[/b]
                    DateX = .Cells(A, 31).Value
                    If DateX >= DateA And DateX <= DateB Then
                        B = B + 1
                        ShtA.Cells(B, 1).Value = B - 3
                        ShtA.Cells(B, 2).Resize(1, 2).Value = .Range(.Cells(A, 2), .Cells(A, 3)).Value
                        ShtA.Cells(B, 4).Resize(1, 1).Value = .Range(.Cells(A, 16), .Cells(A, 16)).Value * 1000
                        ShtA.Cells(B, 5).Resize(1, 2).Value = .Range(.Cells(A, 29), .Cells(A, 30)).Value
                        ShtA.Cells(B, 7).Resize(1, 1).Value = .Range(.Cells(A, 31), .Cells(A, 31)).Value
                    End If
                    [b]End If[/b]
                Next A
            End If
        End If
    End With
Next ShtX

Set ShtA = Nothing
Application.ScreenUpdating = True

End Sub