Em sua rotina de Cadastrar você já tem as instruções para jogar para a aba, seria o caso de adaptar esta da pesquisa, em vez de jogar o resultado para os controles jogar para a aba que quer.
Só não entendi que na aba dados temos 41 Colunas e na Relatorios só 13, de qualquer forma fiz a adaptação em algumas linhas da rotina até o Exercício 1, o restante é só ajustar da mesma forma.
O ideal é colocar um outro botão para jogar o resultado na Aba e manter o do resultado nos controles, logicamente alterando o nome da rotina, tipo "ProcuraPersonalizadaParaAba" e associar a este novo botão.
Uma outra obs, é que apesar de estarem como Private você tem rotina com o nome repetido, o ideal para evitar conflitos futuros é definir nomes diferentes, veja que no formulario "frmrelatorios" a rotina se repete.
Private Sub ProcuraPersonalizada(ByVal TermoPesquisado As String, ByVal sPesquisarNoCampo As String)
Dim Busca As Range
Dim Primeira_Ocorrencia As String
Dim ResultadosLinha As String
Dim ResultadosPlanilha As String
Dim sSearchInCol As String
Dim arrPesquisarNasPlanilhas As Variant
Dim I As Integer
'Define a Coluna onde a informação será pesquisada
sSearchInCol = ConfigColunas(sPesquisarNoCampo)
'Define as Planilhas onde a informação será pesquisada
arrPesquisarNasPlanilhas = ConfigPlanilhasBase
'Inicializa os resultados
ResultadosLinha = ""
ResultadosPlanilha = ""
MatrizResultadosLinha = ""
MatrizResultadosPlanilha = ""
'Executa a busca
For I = 0 To UBound(arrPesquisarNasPlanilhas)
With Sheets(arrPesquisarNasPlanilhas(I))
If sSearchInCol = "" Then
Set Busca = .Cells.Find(What:=TermoPesquisado, After:=.Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Else
Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).Find( _
What:=TermoPesquisado, _
After:=.Range(sSearchInCol & "1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End If
'Caso tenha encontrado alguma ocorrência...
If Not Busca Is Nothing Then
Primeira_Ocorrencia = Busca.Address
ResultadosLinha = ResultadosLinha & IIf((Len(ResultadosLinha) > 0), ";", "") & Busca.Row 'Lista o primeiro resultado na variavel - linha da ocorrência
ResultadosPlanilha = ResultadosPlanilha & IIf((Len(ResultadosPlanilha) > 0), ";", "") & .Index 'Lista o primeiro resultado na variavel - planilha da ocorrência
'Neste loop, pesquisa todas as próximas ocorrências para
'o termo pesquisado
Do
If sSearchInCol = "" Then
Set Busca = .Cells.FindNext(After:=Busca)
Else
Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).FindNext(After:=Busca)
End If
'Condicional para não listar o primeiro resultado
'pois já foi listado acima
If Not Busca.Address Like Primeira_Ocorrencia Then
ResultadosLinha = ResultadosLinha & ";" & Busca.Row
ResultadosPlanilha = ResultadosPlanilha & ";" & .Index
End If
Loop Until Busca.Address Like Primeira_Ocorrencia
End If
End With
Next I
'INICIO RESULTADO NA ABA RELATORIOS =========================================================================
If Len(ResultadosLinha) > 0 Then 'Se foram encontrados resultados
MatrizResultadosLinha = Split(ResultadosLinha, ";")
MatrizResultadosPlanilha = Split(ResultadosPlanilha, ";")
'Atualiza dados iniciais no formulário
SpinButton1.Max = UBound(MatrizResultadosLinha) 'Valor maximo do seletor de registros
'habilita o seletor de registro
SpinButton1.Enabled = True
'indicador do seletor de registros
Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultadosLinha) + 1
'Box com o conteudo encontrado
'Definimos a Sheet
Dim wsRelatorio As Worksheet
'Definimos Aba relatorios
Set wsRelatorio = Worksheets("relatorios")
'Verifica qual a ultima Linha preenchida na coluna A
'Descontando a primeira linha de cabeçalho
lastRow = wsRelatorio.Cells(Rows.Count, 1).End(xlUp).Row + 1
With Sheets(CInt(MatrizResultadosPlanilha(0)))
'Dados cadastrais
wsRelatorio.Cells(lastRow, 1).Value = .Cells(MatrizResultadosLinha(0), 1).Value
wsRelatorio.Cells(lastRow, 2).Value = .Cells(MatrizResultadosLinha(0), 2).Value
wsRelatorio.Cells(lastRow, 3).Value = .Cells(MatrizResultadosLinha(0), 3).Value
wsRelatorio.Cells(lastRow, 4).Value = .Cells(MatrizResultadosLinha(0), 4).Value
'Status do servidor
If .Cells(MatrizResultadosLinha(0), 5).Value = "ATIVO" Then
'OptionButton_Ativo.Value = True
wsRelatorio.Cells(lastRow, 5).Value = "ATIVO"
Else
If .Cells(MatrizResultadosLinha(0), 5).Value = "LICENÇA" Then
wsRelatorio.Cells(lastRow, 6).Value = "LICENÇA"
Else
If .Cells(MatrizResultadosLinha(0), 5).Value = "APOSENTADO" Then
wsRelatorio.Cells(lastRow, 7).Value = "APOSENTADO"
End If
End If
End If
'Data status do servidor
wsRelatorio.Cells(lastRow, 8).Value = .Cells(MatrizResultadosLinha(0), 6).Value
wsRelatorio.Cells(lastRow, 9).Value = .Cells(MatrizResultadosLinha(0), 7).Value
wsRelatorio.Cells(lastRow, 10).Value = .Cells(MatrizResultadosLinha(0), 8).Value
'Período indeferido
If .Cells(MatrizResultadosLinha(0), 9).Value = "SIM" Then
wsRelatorio.Cells(lastRow, 11).Value = "SIM"
Else
If .Cells(MatrizResultadosLinha(0), 9).Value = "NÃO" Then
wsRelatorio.Cells(lastRow, 12).Value = "NÃO"
End If
End If
'Pelo Processo
wsRelatorio.Cells(lastRow, 13).Value = .Cells(MatrizResultadosLinha(0), 10).Value
'Contato em dobro
If .Cells(MatrizResultadosLinha(0), 11).Value = "SIM" Then
wsRelatorio.Cells(lastRow, 14).Value = "SIM"
Else
If .Cells(MatrizResultadosLinha(0), 11).Value = "NÃO" Then
wsRelatorio.Cells(lastRow, 14).Value = "NÃO"
End If
End If
'Exercício 1
wsRelatorio.Cells(lastRow, 15).Value = .Cells(MatrizResultadosLinha(0), 12).Value
wsRelatorio.Cells(lastRow, 16).Value = .Cells(MatrizResultadosLinha(0), 13).Value
wsRelatorio.Cells(lastRow, 17).Value = .Cells(MatrizResultadosLinha(0), 14).Value
wsRelatorio.Cells(lastRow, 18).Value = .Cells(MatrizResultadosLinha(0), 15).Value
'Exercício 2
'........
'.........
'..........
End With
btn_Editar.Enabled = True
btn_Excluir.Enabled = True
'FIM RESULTADO NA ABA RELATORIOS ==================================================================
'Desta linha para baixo não alterei nada
Else 'Caso nada tenha sido encontrado, exibe mensagem informativa
Qualquer duvida retorne.
[]s
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 21/01/2014 7:11 pm