[Resolvido] Pesquisar por mês Excel 2003 e 2007

Boa noite
 
Venho aqui solicitar ajuda para uma pesquisa em várias Abas numa planilha.
 
A planilha que vai em anexo, tem várias Abas.
 
Desde a Aba Ano2019 a Ano2030
 
O que eu pretendo é:
Na Aba Mensal, na célula A2 e na célula A3 serão colocadas datas, em A2 eu coloco (exemplo, 01-03-2023 ) que é o primeiro dia do mês pretendido, e em A3 eu coloco o fim do mês pretendido, ( exemplo, 31-03-2023 ) e o código VBA deverá ir buscar a informação às Abas, Ano2019, Ano2020, Ano2021, Ano2022, Ano2023, Ano2024, Ano2025 até à Aba Ano2030.

Os dados deverão ir para a Aba Mensal desde a célula B7 a J41, e deverá ter o nome da Aba, o Nº da pessoa, o Nome da pessoa, os serviços, os Turnos, a Data a gozar e o Periodo do dia a gozar, referente ao mês que escolhi de todas as pessoas que gozaram nesse mesmo mês e por ordem de data ( por ordem crescente ).
 
Já coloquei um mês como exemplo para verem o que pretendo.

Quando se diz que é para colocar o inicio do mês em A2 e em A3 o fim do mês, também pode ser na célula A2 se colocar Março 2023 e o código VBA fazer a mesma função, ou outra função que faça o que pretendo, o que interessa é o resultado final ser o mesmo que se encontra na Aba Mensal.
 
Pretendo também que, assim que se colocar a primeira data na Aba Mensal na célula A2, deverá limpar toda a área de B7 a J41.
 
Espero que me tenha explicado bem.
 
Obrigado desde já.
 
Cumprimentos

Atualização: 08/04/2023 00:19

---

Resolvido

Aqui fica o código VBA.

Private Sub Worksheet_Change(ByVal Target As Range)



    Dim wsM As Worksheet

    Dim ws  As Worksheet

    Dim LR  As Long

    Dim LRM As Long

    Dim r   As Long



    If Target.Address(False, False) = "A2" Then

        Range("A7:J1000&quot.ClearContents

            ElseIf Target.Address(False, False) = "A3" Then

        Set wsM = Sheets("Mensal&quot

            For Each ws In ThisWorkbook.Worksheets

                With ws

                    If Left(LCase(.Name), 3) = "ano" Then

                        LR = LastRow(ws, 8)

                        For r = 4 To LR

                            If .Cells(r, 8) >= wsM.Range("A2&quot And .Cells(r, 8) <= wsM.Range("A3&quot Then

                                LRM = LastRow(wsM, 3) + 1

                                .Range("B" & r & ":I" & r).Copy

                                wsM.Range("B" & LRM) = .Name

                                wsM.Range("C" & LRM).PasteSpecial xlPasteValues

                            End If

                        Next

                    End If

                End With

            Next

        wsM.Range("B6:J" & LastRow(wsM, 3)).Sort wsM.Range("I6&quot, Header:=xlYes

    End If

    

End Sub



Function LastRow(ByVal ws As Worksheet, ByVal Col As Integer) As Long

    LastRow = ws.Cells(Rows.Count, Col).End(xlUp).Row

End Function

Cumps