Ir ao conteúdo
  • Cadastre-se

Busca em utra plan


Posts recomendados

@Basole, cara desculpa atrapalhar, mas preciso de uma ajuda, se possível.

 

Utilizo o código abaixo  para buscar diversos dados em uma aba da mesma planilha. Como o arquivo está ficando muito pesado, eu criei outra plan com o nome banco_dados e gostaria que a busca fosse feita a partir desse banco e não mais da mesma planilha (laudo de análise). consegue me dar uma força?

 

segue o código.

 

obrigado mais uma vez.



Sub PESQUISA_BANCO()

Application.ScreenUpdating = False


'  *** PESQUISA Macro Codigo ***
    Dim pega As String, cr As Integer, rng As Range, i As Long

    Sheets("LAUDO").Activate
   
    If ThisWorkbook.Sheets("LAUDO").Range("b24").Value <> "" Then
                Exit Sub
    Else

        Range("a36").Activate
        ActiveCell.Activate
        pega = VBA.Trim(ActiveCell.Value)
        If pega = "" Then
            MsgBox "É necessário informar o número de análise!!!", vbExclamation, "PESQUISA"
            
            Exit Sub
        End If
        Sheets("banco_dados").Activate
        cr = 0
        Set rng = ActiveSheet.Range("a" & Rows.Count).End(xlUp)
        For i = 2 To rng.Row
            'aqui você não precisa informar o nome completo
            'mas corre o risco de ficar em duplicidade
            If VBA.Trim(ActiveSheet.Cells(i, 78).Value) = VBA.Trim(pega) Then

                
                Cells(i, 1).Copy
                Range("laudo!I6").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 2).Copy
                Range("laudo!F6").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 3).Copy
                Range("laudo!B4").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 4).Copy
                Range("laudo!c8").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 5).Copy
                Range("laudo!D9").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 6).Copy
                Range("laudo!I9").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 7).Copy
                Range("laudo!D10").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 8).Copy
                Range("laudo!H10").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 9).Copy
                Range("laudo!F10").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 10).Copy
                Range("laudo!D11").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                
                'PARAMETROS
                Cells(i, 11).Copy
                Range("laudo!B14").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 12).Copy
                Range("laudo!B15").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 13).Copy
                Range("laudo!B16").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 14).Copy
                Range("laudo!B17").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 15).Copy
                Range("laudo!B18").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 16).Copy
                Range("laudo!B19").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 17).Copy
                Range("laudo!B20").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 18).Copy
                Range("laudo!B21").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 19).Copy
                Range("laudo!B22").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 20).Copy
                Range("laudo!B23").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 21).Copy
                Range("laudo!B24").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 22).Copy
                Range("laudo!B25").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 23).Copy
                Range("laudo!B26").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 24).Copy
                Range("laudo!B27").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 25).Copy
                Range("laudo!B28").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                'UNIDADE
                Cells(i, 26).Copy
                Range("laudo!E14").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 27).Copy
                Range("laudo!E15").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 28).Copy
                Range("laudo!E16").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 29).Copy
                Range("laudo!E17").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 30).Copy
                Range("laudo!E18").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 31).Copy
                Range("laudo!E19").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 32).Copy
                Range("laudo!E20").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 33).Copy
                Range("laudo!E21").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 34).Copy
                Range("laudo!E22").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 35).Copy
                Range("laudo!E23").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 36).Copy
                Range("laudo!E24").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 37).Copy
                Range("laudo!E25").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 38).Copy
                Range("laudo!E26").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 39).Copy
                Range("laudo!E27").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 40).Copy
                Range("laudo!E28").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                
                'RESULTADO
                Cells(i, 41).Copy
                Range("laudo!F14").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 42).Copy
                Range("laudo!F15").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 43).Copy
                Range("laudo!F16").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 44).Copy
                Range("laudo!F17").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 45).Copy
                Range("laudo!F18").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 46).Copy
                Range("laudo!F19").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 47).Copy
                Range("laudo!F20").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 48).Copy
                Range("laudo!F21").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 49).Copy
                Range("laudo!F22").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 50).Copy
                Range("laudo!F23").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 51).Copy
                Range("laudo!F24").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 52).Copy
                Range("laudo!F25").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 53).Copy
                Range("laudo!F26").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 54).Copy
                Range("laudo!F27").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 55).Copy
                Range("laudo!F28").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                
                 'ESPECIFICADO
                Cells(i, 56).Copy
                Range("laudo!I14").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 57).Copy
                Range("laudo!I15").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 58).Copy
                Range("laudo!I16").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 59).Copy
                Range("laudo!I17").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 60).Copy
                Range("laudo!I18").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 61).Copy
                Range("laudo!I19").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 62).Copy
                Range("laudo!I20").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 63).Copy
                Range("laudo!I21").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 64).Copy
                Range("laudo!I22").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 65).Copy
                Range("laudo!I23").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 66).Copy
                Range("laudo!I24").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 67).Copy
                Range("laudo!I25").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 68).Copy
                Range("laudo!I26").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 69).Copy
                Range("laudo!I27").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 70).Copy
                Range("laudo!I28").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                
                Cells(i, 71).Copy
                Range("laudo!D30").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 72).Copy
                Range("laudo!E30").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 73).Copy
                Range("laudo!C31").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 74).Copy
                Range("laudo!B32").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 75).Copy
                Range("laudo!D33").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 76).Copy
                Range("laudo!J34").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                Cells(i, 77).Copy
                Range("laudo!D35").PasteSpecial (xlPasteValues)
                Application.CutCopyMode = False
                
                
                
                                Sheets("LAUDO").Select
                                cd1 = Range("e8").Value
                                cd = Range("c8").Value
                pergunta = MsgBox("Analise Encontrada!" & _
                                  Chr(13) & "É possível que haja outras análises com o mesmo número," & _
                                  Chr(13) & "quer continuar a busca?" & Chr(13) & _
                                  Chr(13) & "Código do Insumo encontrado: " & cd & _
                                  Chr(13) & "Descrição do Insumo encontrado: " & cd1, _
                                  vbYesNo, "PESQUISA")
                If pergunta = vbNo Then
                    Sheets("LAUDO").Select
                    MsgBox "Fim da Pesquisa!", vbExclamation, "PESQUISA"
                   
                    Exit Sub
                Else
                    'Atenção com esta linha para alteração
                    'o loop pode mudar de direção
                    Sheets("banco_dados").Activate
                End If
                cr = cr + 1
            End If
        Next i
        If cr = 0 Then
            Sheets("LAUDO").Select
            MsgBox "Análise não encontrada!", vbExclamation, "PESQUISA"
        Else
            Sheets("LAUDO").Select
            MsgBox "Fim da busca, nº de análise encontradas: (" & cr & ")", vbExclamation, ""
        End If
    End If
   
    
    Application.ScreenUpdating = True
    
End Sub

 

Link para o comentário
Compartilhar em outros sites

Visitante
Este tópico está impedido de receber novas respostas.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...