Formulário pesquisa, realizar em planilha fechada

2024 - VBA & Macros

Post Recente por rsiqueir 10 anos atrás

4 Posts

2 Usuários

0 Reactions

1,048 Visualizações

RSS

rsiqueir

(@rsiqueir)

Posts: 39

Eminent Member

Topic starter

Pessoal, boa noite!!!

Preciso ajustar o código abaixo para realizar a busca de informações numa planilha a parte, que esteja fechada e salva em outra pasta, realizei um ajuste conforme tópico do fórum, mas funciona pela metade, apenas abre a planilha informada de outra pasta e após isso apresenta erro e não realiza a busca, segue abaixo código e em anexo planilha, caso tenha uma solução ou ideia para ajustar conforme essa minha necessidade agradeço desde já

Private Sub CommandButton1_Click()

With Sheets("localizados")
UltReg = .Cells(Rows.Count, "A").End(xlUp).Row + 1
For i = UltReg To 2 Step -1
.Cells(i, 1).EntireRow.Delete
Next
End With

'Workbooks.Open Filename:="C:matriz2.xlsx" ----> coloquei esse código para abrir a planilha ao qual preciso fazer a busca de informações

'With Sheets("Plan1") ----> código para indicar a Aba a realizar a busca, irá substituir o código abaixo With Sheets("matriz")

With Sheets("matriz")
LinReg = 2
UltReg = .Cells(Rows.Count, "A").End(xlUp).Row + 1

For i = 2 To UltReg
If UCase(Trim(.Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3) & .Cells(i, 4) & .Cells(i, 5) & .Cells(i, 6) & .Cells(i, 7) & .Cells(i, 8) & .Cells(i, 9) & .Cells(i, 10) & .Cells(i, 11) & .Cells(i, 12) & .Cells(i, 13) & .Cells(i, 14) & .Cells(i, 15) & .Cells(i, 17))) Like "*" & UCase(Trim(Me.TextBox1.Value)) & "*" Then

Sheets("localizados").Cells(LinReg, 1) = .Cells(i, 1)
Sheets("localizados").Cells(LinReg, 2) = .Cells(i, 2)
Sheets("localizados").Cells(LinReg, 3) = .Cells(i, 3)
Sheets("localizados").Cells(LinReg, 4) = .Cells(i, 4)
Sheets("localizados").Cells(LinReg, 5) = .Cells(i, 5)
Sheets("localizados").Cells(LinReg, 6) = .Cells(i, 6)
Sheets("localizados").Cells(LinReg, 7) = .Cells(i, 7)
Sheets("localizados").Cells(LinReg, 8) = .Cells(i, 8)
Sheets("localizados").Cells(LinReg, 9) = .Cells(i, 9)
Sheets("localizados").Cells(LinReg, 10) = .Cells(i, 10)
Sheets("localizados").Cells(LinReg, 11) = .Cells(i, 11)
Sheets("localizados").Cells(LinReg, 12) = .Cells(i, 11)
Sheets("localizados").Cells(LinReg, 13) = .Cells(i, 13)
Sheets("localizados").Cells(LinReg, 14) = .Cells(i, 14)
Sheets("localizados").Cells(LinReg, 15) = .Cells(i, 15)
Sheets("localizados").Cells(LinReg, 16) = .Cells(i, 16)
Sheets("localizados").Cells(LinReg, 17) = .Cells(i, 17)

LinReg = LinReg + 1

End If

'ActiveWindow.Close ----> código para fechar a planilha assim que realizar a busca desejada e copiar as informações na aba "localizados"

Next
End With

Sheets("localizados").Activate
Unload Me
MsgBox "Ok", vbInformation, "Sistema de Busca"
End Sub

Anexo planilhas, aguardo uma ajuda

Obrigado!!!!

planilha_completa_correta.xlsm

matriz2.xlsx

Postado : 08/12/2014 7:51 pm

rsiqueir

(@rsiqueir)

Posts: 39

Eminent Member

Topic starter

...

Postado : 09/12/2014 4:10 pm

Reinaldo

(@rlm)

Posts: 246

Estimable Member

Se entendi

Private Sub CommandButton1_Click()

ws = ThisWorkbook.Name
    
With Sheets("localizados")
    UltReg = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    For i = UltReg To 2 Step -1
        .Cells(i, 1).EntireRow.Delete
    Next
End With

'Workbooks.Open Filename:="C:matriz2.xlsx"
Workbooks.Open Filename:="C:UsersReinaldoDownloadsmatriz2.xlsx"


With Sheets("Plan1")
    
LinReg = 2
UltReg = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    
For i = 2 To UltReg
    If UCase(Trim(.Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3) & _
                .Cells(i, 4) & .Cells(i, 5) & .Cells(i, 6) & .Cells(i, 7) & _
                .Cells(i, 8) & .Cells(i, 9) & .Cells(i, 10) & .Cells(i, 11) & _
                .Cells(i, 12) & .Cells(i, 13) & .Cells(i, 14) & .Cells(i, 15) & _
                .Cells(i, 17))) Like "*" & UCase(Trim(Me.TextBox1.Value)) & "*" Then
        
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 1) = .Cells(i, 1)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 2) = .Cells(i, 2)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 3) = .Cells(i, 3)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 4) = .Cells(i, 4)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 5) = .Cells(i, 5)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 6) = .Cells(i, 6)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 7) = .Cells(i, 7)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 8) = .Cells(i, 8)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 9) = .Cells(i, 9)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 10) = .Cells(i, 10)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 11) = .Cells(i, 11)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 12) = .Cells(i, 11)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 13) = .Cells(i, 13)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 14) = .Cells(i, 14)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 15) = .Cells(i, 15)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 16) = .Cells(i, 16)
        Workbooks(ws).Sheets("localizados").Cells(LinReg, 17) = .Cells(i, 17)
        
        LinReg = LinReg + 1
    End If
Next
    ActiveWindow.Close
End With
    
    Sheets("localizados").Activate
    Unload Me
    MsgBox "Ok", vbInformation, "Sistema de Busca"
End Sub

Reinaldo

Postado : 10/12/2014 1:33 pm