InputBox Localizar

Question

Boa tarde,

Alguém pode ajudar, preciso implementar no código abaixo, um InputBox que digite um número de nota e trazer todo os itens dessa nota a linha e colunas determinada e copie cole em outra planilha e uma nova consulta de nota deixa os primeiros dados e cole a partir de uma célula vazia, segue o código. Obrigado!

Sub executar()
        Dim EncontraString As String
        Dim Intervalo As Range
        Dim wsOrigem As Worksheet
        Dim wsDestino As Worksheet
        


        Application.ScreenUpdating = False
        
        'Arquivo Destino, abrimos primeiro
        'Ajuste o caminho do mesmo
        
        Workbooks.Open Filename:="Z:\CDJ\Relatorio Expedicao\prev.xls"
        
        'Arquivos e Abas de Origem e Destino
        Set wsOrigem = Workbooks("prev.xls").Worksheets("prev")
        Set wsDestino = Workbooks("Relatorio Prev.xlsm").Worksheets("Relatorio Prev")
         
         With wsOrigem
                    
                .Range("V4:V1000000").Copy Destination:=wsDestino.Range("A3")
                .Range("I4:I1000000").Copy Destination:=wsDestino.Range("B3")
                .Range("J4:J1000000").Copy Destination:=wsDestino.Range("C3")
                .Range("P4:P1000000").Copy Destination:=wsDestino.Range("D3")
                .Range("K4:K1000000").Copy Destination:=wsDestino.Range("E3")
                
 

            End With
            
        
      'Fecha o Arquivo de etração dos dados
        Workbooks("prev.xls").Close SaveChanges:=True
        MsgBox "Introdução de Dados Concluída"


End Sub 

Answer 1

Por favor, explique melhor o caso.

O código acima está copiando dados de uma planilha para outra.

Você quer restringir a cópia ?

Ou quer pesquisar as notas em outro momento ?

Answer 2

Bom dia André,

Então estou prescisando de uma planilha que eu digite em um inputbox o número de uma nota e traga toda descrição dessa nota (os itens da nota), e copie e cole em outra planilha, e ao digitar um novo número de nota (Uma nova pesquisa), ele copie e cole novamente, abaixo dos intens que foram pesquisado da primeira vez, sem apagar os dados da primeira consulta, o codigo acima já faz a copia e a cola, mas não tem o inputbox para percorrer a coluna e trazer o numero da nota que quero pesquisar.

Muito obrigado pela ajuda.

Answer 3

Alexsandro, fiz um código aqui para começarmos a trabalhar.

Atente-se para trocar nomes de planilhas, endereços de célula, etc, para funcionar no seu caso.

Por favor, marque como resposta se a informação lhe for útil

Sub procuraNota()

Dim nf As Variant
Dim qtdNotas As Integer

Sheets("Plan1").Select

qtdNotas = 0
nf = InputBox("Digite o nº da nota fiscal", "Pesquisa de NF")

If IsNull(nf) Or nf = "" Then
    MsgBox "NF inválida", vbInformation + vbOKOnly, "Pesquisa de NF"
    Exit Sub
Else
    Range("A1").AutoFilter 1, nf
    
        For Each cell In Sheets("Plan1").AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows
             qtdNotas = qtdNotas + 1
        Next
        
        If qtdNotas <= 0 Then
            MsgBox "Nenhuma nota encontrada !", vbInformation + vbOKOnly, "Pesquisa de NF"
            Exit Sub
        Else
            Sheets("Plan1").AutoFilter.Range.SpecialCells(xlCellTypeVisible).Select
            Selection.Copy
            
            Sheets("Plan2").Select
            Range("A1").PasteSpecial xlPasteValues
        End If
    
End If

End Sub

Answer 4

OBS: Esse código busca na plan1 o número da nota, considerando que ele está na primeira coluna (A)

Answer 5

André bom dia,

Muito obrigado, ajudou bastante.

Answer 6

As ordens, por favor, marque como resposta !

Abs