none
InputBox Localizar RRS feed

  • Pergunta

  • 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 


    terça-feira, 23 de junho de 2015 15:01

Respostas

  • 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

    quinta-feira, 25 de junho de 2015 19:19

Todas as Respostas

  • 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 ?

    quarta-feira, 24 de junho de 2015 16:05
  • 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.

    quinta-feira, 25 de junho de 2015 14:44
  • 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

    quinta-feira, 25 de junho de 2015 19:19
  • OBS: Esse código busca na plan1 o número da nota, considerando que ele está na primeira coluna (A)
    quinta-feira, 25 de junho de 2015 19:20
  • André bom dia,

    Muito obrigado, ajudou bastante.

    sexta-feira, 26 de junho de 2015 12:42
  • As ordens, por favor, marque como resposta !

    Abs

    sexta-feira, 26 de junho de 2015 13:38