Проблема с поиском и копированием дат

[manula]

Здравствуйте уважаемые коллеги, не могли бы вы мне помочь с решением моей проблемы, над которой я бьюсь уже битый день. Суть вот в чем: на "Лист1" есть два заполненных столбца "Дата начала периода" и "Дата окончания периода" при нажатии на кнопку я должен сравнивать текущий(системный) месяц с месяцами находящиеся на "Лист1". Если я нашел такой месяц текущего года то эта найденная запись должна копироваться на лист текущего месяца. В моей книге у меня данная процедура срабатывает единожды, как мне преобразовать или можно решить данную проблему, помогите пожалуйста коллеги!

[SAS888]

Замените Ваш код на следующий:

Private Sub CommandButton1_Click()
    Dim i As Long, m As Integer, mm As Integer, y As Integer, ws As Worksheet
    Dim yy As Integer, md As Integer, yd As Integer: Application.ScreenUpdating = False
    md = Month(Date): yd = Year(Date)
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        m = Month(Cells(i, 1)): mm = Month(Cells(i, 2))
        y = Year(Cells(i, 1)): yy = Year(Cells(i, 2))
        If (m = md And y = yd) Or (mm = md And yy = yd) Then
            On Error Resume Next
            Set ws = Sheets(MonthName(m))
            If Err <> 0 Then
                On Error GoTo 0
                Sheets.Add(, Sheets(Sheets.Count)).Name = MonthName(m)
                Set ws = ActiveSheet
            End If
            Sheets("Лист1").Activate
            Rows(i).Copy ws.Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
    Next
End Sub

Если листа с именем требуемого месяца нет, то он будет создан. Если такой лист есть, то найденные строки будут скопированы в этот лист ниже.

P. S. По непонятной причине, не могу прикрепить ни rar ни zip архив... (ошибка загрузки)