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".ClearContents
ElseIf Target.Address(False, False) = "A3" Then
Set wsM = Sheets("Mensal"
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" And .Cells(r, 8) <= wsM.Range("A3" 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", 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
Bikke
Super Participante
Registrado
255 Mensagens
46 Curtidas
[Resolvido] Pesquisar por mês Excel 2003 e 2007
#1 Por Bikke
07/04/2023 - 18:11