VBA - Erro em tempo de execução '9'

Bonfim · Mensagem por **Bonfim** » Sex Jul 26, 2019 10:38 am

Olá a todos.
Estou tentando copiar uma planilha para outra.
Ao executar a Macro retorna a mensagem:
Erro em tempo de execução '9': Subscrito fora do intervalo.

01 - Planilha a ser copiada
CLIENTE AOX DATA_CADASTRO TIPO_PESSOA CPF_CNPJ DDD_FONE NUM_FONE EMAIL

02 - Código

Código: Selecionar todos

Option Explicit


Sub tranferirDadosNovaAba()
' Aba Cadastro

Dim ca_cliente As String
Dim ca_aox As String
Dim ca_data_cadastro As String
Dim ca_tipo_pessoa As String
Dim ca_cpf_cnpj As String
Dim ca_ddd_fone As String
Dim ca_num_fone As String
Dim ca_email As String


' Controle
Dim ultimaFila As Long
Dim ultimaFilaAuxiliar As Long
Dim cont As Long

ultimaFila = Sheets("CADASTRO").Range("A" & Rows.Count).End(xlUp).Row ' pegar ultima fila em branco

If ultimaFila < 2 Then
    Exit Sub
End If

For cont = 8 To ultimaFila
    ca_cliente = Sheets("CADASTRO").Cells(cont, 2)
    ca_aox = Sheets("CADASTRO").Cells(cont, 3)
    ca_data_cadastro = Sheets("CADASTRO").Cells(cont, 4)
    ca_tipo_pessoa = Sheets("CADASTRO").Cells(cont, 5)
    ca_cpf_cnpj = Sheets("CADASTRO").Cells(cont, 6)
    ca_ddd_fone = Sheets("CADASTRO").Cells(cont, 7)
    ca_num_fone = Sheets("CADASTRO").Cells(cont, 8)
    ca_email = Sheets("CADASTRO").Cells(cont, 9)
    
    
   ultimaFilaAuxiliar = Sheets("CADAUX").Range("A" & Rows.Count).End(xlUp).Row
   
   Sheets("ultimaFilaAuxiliar").Cells(ultimaFilaAuxiliar + 1, 2) = ca_cliente
   Sheets("ultimaFilaAuxiliar").Cells(ultimaFilaAuxiliar + 1, 3) = ca_aox
   Sheets("ultimaFilaAuxiliar").Cells(ultimaFilaAuxiliar + 1, 4) = ca_data_cadastro
   Sheets("ultimaFilaAuxiliar").Cells(ultimaFilaAuxiliar + 1, 5) = ca_tipo_pessoa
   Sheets("ultimaFilaAuxiliar").Cells(ultimaFilaAuxiliar + 1, 6) = ca_cpf_cnpj
   Sheets("ultimaFilaAuxiliar").Cells(ultimaFilaAuxiliar + 1, 7) = ca_ddd_fone
   Sheets("ultimaFilaAuxiliar").Cells(ultimaFilaAuxiliar + 1, 8) = ca_num_fone
   Sheets("ultimaFilaAuxiliar").Cells(ultimaFilaAuxiliar + 1, 9) = ca_email
     
Next cont
 ultimaFilaAuxiliar = Sheets("CADAUX").Range("A" & Rows.Count).End(xlUp).Row
MsgBox "Processo terminado", vbInformation, "Resultado"

End Sub

linha do erro : Sheets("ultimaFilaAuxiliar").Cells(ultimaFilaAuxiliar + 1, 2) = ca_cliente

Agradeço antecipadamente a quem puder me auxiliar.

Bonfim

Bonfim · Mensagem por **Bonfim** » Sex Jul 26, 2019 10:44 am

Anexei a planilha para verificação.

Atenciosamente,
Bonfim

Reinaldo · Mensagem por **Reinaldo** » Sex Jul 26, 2019 4:20 pm

Sua rotina remete a uma planilha que não está presente no modelo enviado
Quero crer que a planilha "receptora" dos dados tenha o nome "CADAUX",
altere esse nome de planilha para "ultimaFilaAuxiliar"; ou (preferivel)
altere o endereçamento de planilha :
onde está: --> Sheets("ultimaFilaAuxiliar")
altere para:--> Sheets("CADAUX")

Teste/experimente

Bonfim · Mensagem por **Bonfim** » Sex Jul 26, 2019 7:39 pm

Ronaldo,
Muito obrigado pela resposta.
Fiz as alterações e funcionou corretamente.

O código ficou assim:

Código: Selecionar todos

Sub tranferirDadosNovaAba()
' Aba Cadastro

Dim ca_cliente As String
Dim ca_aox As String
Dim ca_data_cadastro As String
Dim ca_tipo_pessoa As String
Dim ca_cpf_cnpj As String
Dim ca_ddd_fone As String
Dim ca_num_fone As String
Dim ca_email As String


' Controle
Dim ultimaFila As Long
Dim ultimaFilaAuxiliar As Long
Dim cont As Long

ultimaFila = Sheets("CADASTRO").Range("A" & Rows.Count).End(xlUp).Row ' pegar ultima fila em branco


If ultimaFila < 1 Then
    Exit Sub
End If

For cont = 1 To ultimaFila
    ca_cliente = Sheets("CADASTRO").Cells(cont, 1)
    ca_aox = Sheets("CADASTRO").Cells(cont, 2)
    ca_data_cadastro = Sheets("CADASTRO").Cells(cont, 3)
    ca_tipo_pessoa = Sheets("CADASTRO").Cells(cont, 4)
    ca_cpf_cnpj = Sheets("CADASTRO").Cells(cont, 5)
    ca_ddd_fone = Sheets("CADASTRO").Cells(cont, 6)
    ca_num_fone = Sheets("CADASTRO").Cells(cont, 7)
    ca_email = Sheets("CADASTRO").Cells(cont, 8)
        
   ultimaFilaAuxiliar = Sheets("CADAUX").Range("A" & Rows.Count).End(xlUp).Row
   
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 1) = ca_cliente
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 2) = ca_aox
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 3) = ca_data_cadastro
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 4) = ca_tipo_pessoa
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 5) = ca_cpf_cnpj
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 6) = ca_ddd_fone
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 7) = ca_num_fone
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 8) = ca_email
    

Next cont
     ultimaFilaAuxiliar = Sheets("CADAUX").Range("A" & Rows.Count).End(xlUp).Row
     
MsgBox "Processo terminado", vbInformation, "Resultado"

End Sub

Agora eu preciso de fazer o tratamento dos dados de cada coluna.
1 - A planilha destino tem gravar todos os dados como texto.
2 - Preciso tratar esse para que fique somente com o formato data
30/07/2011 17:53:35
daí com substring consigo resolver.

3 - Na coluna E preciso adicionar uma quantidade de caracteres '0' a esquerda.
então preciso contar e adicionar o que falta.
qual comando eu faço isso ?

4 - Por fim como eu pego cada coluna pra tratar antes de efetuar a cópia ?

Abraços
Bonfim

Reinaldo · Mensagem por **Reinaldo** » Sex Jul 26, 2019 8:59 pm

"..todos os dados como texto.."
Uma maneira de "forçar" os dados como texto é concatenar o valor com apostrofe simples " ' "
Ex.:ca_cliente = "'" & Sheets("CADASTRO").Cells(cont, 1)

"..com o formato data.."
Experimente: ca_data_cadastro = "'" & CDate(Int(Sheets("CADASTRO").Cells(cont, 3).Value2))

"..uma quantidade de caracteres '0' a esquerda.."
Não especificou a qtde de caracteres, supondo que seja 14
Experimente: ca_cpf_cnpj = "'" & Application.WorksheetFunction.Rept("0", 14 - Len(Sheets("CADASTRO").Cells(cont, 5))) & Sheets("CADASTRO").Cells(cont, 5)

"..como eu pego cada coluna pra tratar antes.."
Não entendi a demanda/necessidade

Sua rotina conforme proposto acima

Código: Selecionar todos

Sub tranferirDadosNovaAba()
' Aba Cadastro
Dim ca_cliente As String, ca_aox As String, ca_data_cadastro As String
Dim ca_tipo_pessoa As String, ca_cpf_cnpj As String, ca_ddd_fone As String
Dim ca_num_fone As String, ca_email As String

' Controle
Dim ultimaFila As Long
Dim ultimaFilaAuxiliar As Long
Dim cont As Long

ultimaFila = Sheets("CADASTRO").Range("A" & Rows.Count).End(xlUp).Row ' pegar ultima fila em branco

If ultimaFila < 1 Then Exit Sub

For cont = 2 To ultimaFila
    ca_cliente = "'" & Sheets("CADASTRO").Cells(cont, 1).Value2
    ca_aox = "'" & Sheets("CADASTRO").Cells(cont, 2).Value2
    ca_data_cadastro = "'" & CDate(Int(Sheets("CADASTRO").Cells(cont, 3).Value2))
    ca_tipo_pessoa = "'" & Sheets("CADASTRO").Cells(cont, 4)
    ca_cpf_cnpj = "'" & Application.WorksheetFunction.Rept("0", 14 - Len(Sheets("CADASTRO").Cells(cont, 5).Value2)) & Sheets("CADASTRO").Cells(cont, 5).Value2
    ca_ddd_fone = "'" & Sheets("CADASTRO").Cells(cont, 6).Value2
    ca_num_fone = "'" & Sheets("CADASTRO").Cells(cont, 7).Value2
    ca_email = "'" & Sheets("CADASTRO").Cells(cont, 8).Value2
        
   ultimaFilaAuxiliar = Sheets("CADAUX").Range("A" & Rows.Count).End(xlUp).Row
   
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 1) = ca_cliente
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 2) = ca_aox
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 3) = ca_data_cadastro
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 4) = ca_tipo_pessoa
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 5) = ca_cpf_cnpj
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 6) = ca_ddd_fone
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 7) = ca_num_fone
   Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 8) = ca_email
Next cont
     MsgBox "Processo terminado", vbInformation, "Resultado"
End Sub

Bonfim · Mensagem por **Bonfim** » Sáb Jul 27, 2019 11:50 am

Reinaldo,
Era justamente isso que gostaria de fazer.
Ocorre que quando eu vou exportar a planilha em CSV alguns dados ficam desconfigurados.
Por exemplo: CPF ou CNPJ ficam com notação científica.
Então a ideia é fazer o tratamento antes e salvar tudo no formato texto pois ai não terei problema na exportação.

Mais uma vez obrigado pela ajuda com exemplos.
Att.
Bonfim

Bonfim · Mensagem por **Bonfim** » Seg Jul 29, 2019 1:10 pm

Ronaldo,
mais uma vez estou aqui para pedir ajuda.
Fiz alguns ajustes no código, mas acho que não é a melhor prática.
Não consegui validar ddd_fone e num fone fora do For.

Na cópia que faço a linha 1 Cabeçalho não está sendo copiada.
Como fazer para copiar sem validar pois certamente daria erro.

Esse é o código atualizado.

Código: Selecionar todos

Sub tranferirDadosNovaAba()
    ' Aba Cadastro
    Dim ca_cliente As String, ca_aox As String, ca_data_cadastro As String
    Dim ca_tipo_pessoa As String, ca_cpf_cnpj As String, ca_ddd_fone As String
    Dim ca_num_fone As String, ca_email As String
    Dim ddd_aux, fone_aux As String
         
    ' Controle
    Dim ultimaFila As Long
    Dim ultimaFilaAuxiliar As Long
    Dim cont As Long
 
    Sheets("CADAUX").Cells.NumberFormat = "@"
    ultimaFila = Sheets("CADASTRO").Range("A" & Rows.Count).End(xlUp).Row ' pegar ultima fila em branco

    If ultimaFila < 1 Then Exit Sub

    For cont = 2 To ultimaFila

        ca_cliente = Sheets("CADASTRO").Cells(cont, 1)
        ca_aox = Sheets("CADASTRO").Cells(cont, 2)
        ca_data_cadastro = CDate(Int(Sheets("CADASTRO").Cells(cont, 3).Value2))
        ca_tipo_pessoa = Sheets("CADASTRO").Cells(cont, 4)
        ca_cpf_cnpj = validaCpf(ca_tipo_pessoa, Sheets("CADASTRO").Cells(cont, 5))
        ca_ddd_fone = ValidaDdd(Sheets("CADASTRO").Cells(cont, 6))
        ca_num_fone = ValidaTel(Sheets("CADASTRO").Cells(cont, 7))
        ca_email = ValidaEmail(Sheets("CADASTRO").Cells(cont, 8))
        
        If Len(ca_ddd_fone) < 2 Or Len(ca_num_fone) < 8 Then
            ca_ddd_fone = ""
            ca_num_fone = ""
        End If
        
        
        ultimaFilaAuxiliar = Sheets("CADAUX").Range("A" & Rows.Count).End(xlUp).Row
   
        Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 1) = ca_cliente
        Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 2) = ca_aox
        Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 3) = ca_data_cadastro
        Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 4) = ca_tipo_pessoa
        Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 5) = ca_cpf_cnpj
        Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 6) = ca_ddd_fone
        Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 7) = ca_num_fone
        Sheets("CADAUX").Cells(ultimaFilaAuxiliar + 1, 8) = ca_email
    Next cont
    MsgBox "Processo terminado", vbInformation, "Resultado"
End Sub

Public Function validaCpf(ByVal ca_tipo_pessoa As String, ByVal ca_cpf_cnpj As String)
    If ca_tipo_pessoa = "F" And Len(ca_cpf_cnpj) < 11 Then
        validaCpf = Right("00000000000" & ca_cpf_cnpj, 11)
    Else
        If ca_tipo_pessoa = "J" And Len(ca_cpf_cnpj) < 14 Then
            validaCpf = Right("00000000000000" & ca_cpf_cnpj, 14)
        Else
            validaCpf = ca_cpf_cnpj
        End If
    End If
   
End Function

Public Function ValidaEmail(ByVal ca_email As String)
    If (InStr(ca_email, "@") > 0) Then
        ValidaEmail = ca_email
    Else
        ValidaEmail = ""
    End If
End Function

Public Function ValidaDdd(ByVal ca_ddd_fone As String)
    If Len(ca_ddd_fone) < 2 Or Len(ca_ddd_fone) > 2 Then
        ValidaDdd = ""
    Else
        ValidaDdd = ca_ddd_fone
    End If
End Function

Public Function ValidaTel(ByVal ca_num_fone As String)
    If Len(ca_num_fone) < 8 Then
        ValidaTel = ""
    Else
        ValidaTel = ca_num_fone
    End If
End Function

Obrigado pelo suporte.
Bonfim

VBA - Erro em tempo de execução '9'

VBA - Erro em tempo de execução '9'

Re: VBA - Erro em tempo de execução '9'

Re: VBA - Erro em tempo de execução '9'

Re: VBA - Erro em tempo de execução '9'

Re: VBA - Erro em tempo de execução '9'

Re: VBA - Erro em tempo de execução '9'

Re: VBA - Erro em tempo de execução '9'