Выборка по дате

[Extril]

Добрый день , уважаемые форумчане. У меня вопрос, возможно ли переделать макрос, который в открытой книге просматривает лист2 и лист3, по столбцу F (столбец содержит даты). Когда дата оказывается в диапазоне (сегодня+7 дней), найденные строки копируются в лист 1.
Попробовал макрос следующего содержания

Private Sub VIBOR()
Dim M()
Dim ST
Dim R As Integer
Dim C As Integer
Dim S As Integer
Dim N As Date
Dim K As Date
Dim D As Date
Dim Z As Integer

Лист1.Select
N = Лист1.Range("C1").Value
K = Лист1.Range("E1").Value
Z = 10

ST = Лист1.Columns(1).Rows(65536).End(xlUp).Row
M = Лист1.Range(Cells(7, 1), Cells(ST, 11)).Value

Лист2.Select
  Лист2.Rows("10:1000").ClearContents   '
For R = 1 To ST - 6
    For C = 5 To 10
        D = M(R, C)
            If D >= N And D <= K Then
                For S = 1 To 10
                Лист2.Cells(Z, S) = M(R, S)
                Next S
                Z = Z + 1
            End If
    Next C
Next R
End Sub

Но мне не хватает знаний адаптировать его под свои условия, подскажите пожалуйста, что в нем можно изменить пытливому неучу ))))))



________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE]
(это кнопочка на панели форматирования с решёточкой #)
Не забывайте об этом!

Модератор.

[staniiislav]

можно как-то так:

Option Explicit

Sub copy_date()
Dim i&, sh As Worksheet, iCell As Range, iDate As Date, lsRow&

    Set sh = ThisWorkbook.Sheets("Лист1")
    
    iDate = Date+7
    For i = 1 To ThisWorkbook.Sheets.Count
        If Sheets(i).Name = "Лист2" Or Sheets(i).Name = "Лист3" Then
            With Sheets(i)
                For Each iCell In .Range("F2:F" & .Cells(Rows.Count, "F").End(xlUp).Row)
                    If iCell = iDate Then lsRow = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1: _
                    .Range("A" & iCell.Row & ":F" & iCell.Row).Copy Destination:=sh.Range("A" & lsRow)
                Next iCell
            End With
        End If
    Next i
End Sub

[SaLoKiN]

в диапазоне (сегодня+7 дней)

это точно не

 If iCell = iDate

тогда уж вот так

Option Explicit

Sub copy_date()
Dim i&, sh As Worksheet, iCell As Range, iDate As Date, lsRow&

    Set sh = ThisWorkbook.Sheets("Лист1")
    
    iDate = Date + 7
    For i = 1 To ThisWorkbook.Sheets.Count
        If Sheets(i).Name = "Лист2" Or Sheets(i).Name = "Лист3" Then
            With Sheets(i)
                For Each iCell In .Range("F1:F" & .Cells(Rows.Count, "F").End(xlUp).Row)
                    If ((iCell <= iDate) And (iCell >= Date)) Then lsRow = sh.Cells(Rows.Count, "F").End(xlUp).Row + 1: _
                   .Range("A" & iCell.Row & ":F" & iCell.Row).Copy Destination:=sh.Range("A" & lsRow)
                Next iCell
            End With
        End If
    Next i
End Sub

[Extril]

Спасибо. работает. А можно уточняющий вопрос, как сделать, что бы при каждом запуске макроса, старые данные очищались. Поиск шел также по второму условию, если в столбце A данные сеть, а в F пусто, то такая строка также копируется