Ir ao conteúdo
  • Cadastre-se
Adriano Delvali

Busca em utra plan

Recommended Posts

@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

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Segue @Basole, dei uma limpada nas macros e listas para facilitar.

 

depois de preenchido tanto a gravação quanto a busca de dados é feita na aba banco_dados. a ideia é fazer isso em uma planilha separada.

laudo.xls

Editado por Adriano Delvali

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações 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

×