Ir ao conteúdo
  • Cadastre-se

Problema em código excel


Posts recomendados

Bom dia

 

 

Fiz um código vba para um botão no excel salvar novos endereços ou alterar existentes (único botão).

estou com problema, porque está dando alterar mesmo que o endereço seja novo.

Poderiam dar uma olhada no código?

 

Public Sub lsAlteraEnd()
 
    Dim lUltimaLinhaAtiva As Long, Resp As Integer
    Dim wsR As Worksheet, wsC As Worksheet, c As Range
    Dim j As Long
    
 
    Application.ScreenUpdating = False
    
    
    Set wsR = Worksheets("REGISTRO ENDEREÇOS"): Set wsC = Sheets("CONSULTA ENDEREÇOS")
     With wsR
    Set c = .Range("A:A").Find(wsC.[E5], LookAt:=xlWhole)
   
      If c Is Nothing Then
        
        
            If .[a2] = "" Then
            j = 1
            Else:
            j = wsR.Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1
       
            If IsNumeric(wsR.Cells(j - 1, 1)) Then
                 wsR.Cells(j, 1) = wsR.Cells(j - 1, 1) + 1
            Else
                 wsR.Cells(j, 1) = 1
            End If
            End If
            
        [h54] = FormatDateTime((Str(Now)), vbGeneralDate)
        [e10] = "=IFERROR(INDEX(Tabela1[REGIONAL],MATCH(E5,Tabela1[COD],0)),"""")"
        [e12] = "=IFERROR(INDEX(Tabela1[TIPO],MATCH(E5,Tabela1[COD],0)),"""")"
 
        .Cells(j, 2).Resize(, 1).Value = _
                Application.Transpose(wsC.Range("e7").Resize(1).Value)
        .Cells(j, 3).Resize(, 21).Value = _
                Application.Transpose(wsC.Range("e9").Resize(21).Value)
        .Cells(j, 24).Resize(, 18).Value = _
                Application.Transpose(wsC.Range("H10").Resize(21).Value)
        .Cells(j, 45).Resize(, 20).Value = _
                Application.Transpose(wsC.Range("E33").Resize(20).Value)
        .Cells(j, 65).Resize(, 20).Value = _
                Application.Transpose(wsC.Range("H33").Resize(20).Value)
        .Cells(j, 85).Resize(, 1).Value = _
                Application.Transpose(wsC.Range("E54").Resize(1).Value)
        .Cells(j, 86).Resize(, 1).Value = _
                Application.Transpose(wsC.Range("H54").Resize(1).Value)
 
        Else
        Resp = MsgBox("O endereço será alterado, confirma alteração?", vbYesNo, "Confirmação")
            If Resp = vbYes Then
            
            [h54] = FormatDateTime((Str(Now)), vbGeneralDate)
            [e10] = "=IFERROR(INDEX(Tabela1[REGIONAL],MATCH(E5,Tabela1[COD],0)),"""")"
            [e12] = "=IFERROR(INDEX(Tabela1[TIPO],MATCH(E5,Tabela1[COD],0)),"""")"
 
 
        .Cells(c.Row, 2).Resize(, 1).Value = _
                Application.Transpose(wsC.Range("e7").Resize(1).Value)
        .Cells(c.Row, 3).Resize(, 21).Value = _
                Application.Transpose(wsC.Range("e9").Resize(21).Value)
        .Cells(c.Row, 24).Resize(, 18).Value = _
                Application.Transpose(wsC.Range("H10").Resize(21).Value)
        .Cells(c.Row, 45).Resize(, 20).Value = _
                Application.Transpose(wsC.Range("E33").Resize(20).Value)
        .Cells(c.Row, 65).Resize(, 20).Value = _
                Application.Transpose(wsC.Range("H33").Resize(20).Value)
        .Cells(c.Row, 85).Resize(, 1).Value = _
                Application.Transpose(wsC.Range("E54").Resize(1).Value)
        .Cells(c.Row, 86).Resize(, 1).Value = _
                Application.Transpose(wsC.Range("H54").Resize(1).Value)
            Else: Exit Sub
          End If
       End If
    
    
    
    lUltimaLinhaAtiva = wsR.Cells(wsR.Rows.Count, 1).End(xlUp).Row
      
   wsR.ListObjects("Tabela1").Resize Range("$A$1:$ch$" & lUltimaLinhaAtiva)
 
    lcopiaDados
    
 
    Sheets("CONSULTA ENDEREÇOS").Select
    
    lslimpaMovimentoConsEnd
    
    
    Application.ScreenUpdating = True
    End With
    
End Sub
 
 
Obrigada
 
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...