ErroS em tempo de execução

[MrcFz]

Olá,
Sou usuário de excel e venho desenvolvendo pastas e planilhas para ajudar na administração do meu negócio, não sou desenvolvedor, só um interessando, esse problema deve ser ridículo para os profissionais.
Tenho uma pasta em que faço o orçamento dos meus serviços, nele tenho uma planilha com uma lista de produtos com 8 colunas e número variável de linhas.
Pelas características do meu negócio, raramente faço orçamentos simultâneos e a lista de produtos e custos é alterada/atualizada nesses momentos.
O que eu quero: Após ou durante a elaboração de um orçamento, criar uma nova pasta e copiar a Lista de produtos, criando um backup ou fonte para a atualização de novos orçamentos, caso essa pasta já exista, renomear a anterior acrescentando a data.

Aqui vai o código que escrevi.

Código: Selecionar todos

Private Sub Cria_ListaProdutos()
    
    Dim FFileName As String                                 ' Variável que recebe o caminho e nome do arquivo
    Dim FFimtabela As Long
    Dim CConta As Long
    
    Worksheets("ListaProdutos").Activate                    ' Na Pasta de origem, seleciona a planilha com a Lista de _ 
 Produtos como ativa
    ActiveCell.Range("K1").Select                           ' Seleciona a célula K1
    CConta = ActiveCell.Value                            ' Copia o valor da célula para a variável
    FFimTab = (CConta + 1)                               ' Adiciona 1 ao valor
    MsgBox (FFimTab)                                        ' Mensagem temporária para verificação
    Range("A1", "H" & FFimTab).Select                       ' Seleciona o Range para a cópia dos valores
    Selection.Copy                                          ' Copia os valores
        
    FFileName = Dir("C:\Controle\ListaProdutos.xlsx")      ' Comando DIR busca se uma  determinada pasta existe
    If FFileName <> "" Then                                            ' Se a pasta existir
        Workbooks("ListaProdutos.xlsx").Select                  ' Ativa a pasta
        ActiveWorkbook.SaveAs Filename:=("C:\Controle\") & ("ListaProdutos") & [text(today(),"yyyymmdd")] & ".xlsx" ' Salva uma cópia com outro nome
    Else: MsgBox ("Arquivo não existe")                     ' Se a pasta não existir, cria a pasta
          
    GoTo Cria
    End If
    
Cria:
    Workbooks.Add                                           ' Cria uma nova Pasta
    ActiveWorkbook.SaveAs Filename:=("C:\Controle\") & ("ListaProdutos")  ' Salva essa pasta com o nome especificado
    ActiveSheet.Name = "ListaProdutos"                      ' Renomeia a planilha ativa
    Range("A1").Select                                      ' Seleciona a celula ativa
    ActiveSheet.Paste
    ActiveWorkbook.Save
    
End Sub

O primeiro erro: Erro 9 - Subscrito fora do Intervalo, ocorre se a pasta já existe.

Se a pasta não existe, ela é criada, a planilha renomeada, mas na hora de colar os dados na linha "ActiveSheet.Paste" o segundo erro: Erro 1004 - Método Paste da Classe WorkSheets falhou.

Agradeço toda ajuda.

[Reinaldo]

Não sei se entendi corretamente a demanda, experimente:

Código: Selecionar todos

Private Sub Cria_ListaProdutos()
    
Dim FFileName As String                         ' Variável que recebe o caminho e nome do arquivo
Dim sPath As String, NFileName As String        ' Variavel de Local e Novo nome
Dim FFimtabela As Long
Dim CConta As Long


Worksheets("ListaProdutos").Activate            ' Na Pasta de origem, seleciona a planilha com a Lista de Produtos como ativa
ActiveCell.Range("K1").Select                   ' Seleciona a célula K1
CConta = ActiveCell.Value                       ' Copia o valor da célula para a variável
FFimTab = (CConta + 1)                          ' Adiciona 1 ao valor
MsgBox (FFimTab)                                ' Mensagem temporária para verificação
Range("A1", "H" & FFimTab).Select               ' Seleciona o Range para a cópia dos valores
Selection.Copy                                  ' Copia os valores

'Determina o caminho
sPath = "D:\Controle\"

'"Monta" novo nome para utilizar se necessario
NFileName = sPath & "ListaProdutos" & [text(today(),"yyyymmdd")] & ".xlsx"
    
FFileName = Dir(sPath & "ListaProdutos.xlsx")      ' Comando DIR busca se uma  determinada pasta existe
If FFileName <> "" Then                                ' Se a pasta existir
    Name sPath & FFileName As NFileName
Else
    MsgBox ("Arquivo não existe")                     ' Se a pasta não existir, cria a pasta
      
    MsgBox FFileName
    ' Cria uma nova Pasta e salva no local especificado
    Sheets("ListaProdutos").Copy
    ActiveWorkbook.SaveAs Filename:="D:\Controle\ListaProdutos.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
End If
End Sub

[MrcFz]

Olá Reinaldo,

Obrigado pela ajuda, não consegui fazer funcionar com seu código, mas as com suas dicas, modifiquei meu código e agora está funcionando.

No caminho inverso que seria copiar da pasta "ListaProdutos.xlsx" de volta para a pasta original, na planilha ListaProdutos, tenho o mesmo erro 1004: Metodo Paste da Classe Worksheet falhou e estou usando exatamente a mesma estrutura.

Workbooks("Orçamento.xltm").Worksheets("ListaProdutos").Activate ' Ativa a pasta de destino
Range("A1").Select ' Seleciona a celula ativa
ActiveSheet.Paste ' Cola os dados
ActiveWorkbook.Save ' Salva os dados na pasta
Application.CutCopyMode = False ' Remove a seleção de células

Ainda não consigo enxergar os erros.

abs

[Reinaldo]

"..não consegui fazer funcionar com seu código.."
Provavelmente por que utilizei o caminho como disco D "..D:\Controle\..", e o seu inicial disco c "..C:\Controle\.."

"..Ainda não consigo enxergar os erros.."
Supus que o proposto auxiliaria, mas somente pela rotina, sem poder acompanhar o avanço no modelo fica complicado

[MrcFz]

"..Ainda não consigo enxergar os erros.."
Supus que o proposto auxiliaria, mas somente pela rotina, sem poder acompanhar o avanço no modelo fica complicado

E ajudou muito, aprendi coisas!

O código é simples, dentro do que sei fazer:

Private Sub Cola_ListaProdutos()

Dim FFileName As String ' Variável que recebe o caminho e nome do arquivo
Dim FFimTab As Long
Dim CConta As Long
Dim WWorkBs As Workbook

' Copiar
Set WWorkBs = Workbooks.Open("C:\Controle\ListaProdutos.xlsx") ' Atribui a variável o caminho/nome do arquivo e Abre a pasta
Worksheets("ListaProdutos").Activate ' Ativa a planilha com os dados
Range("K1").Select ' Seleciona e ativa a celula k1, com Cont.Value
FFimTab = ActiveCell.Value ' Copia o valor da célula para a variável
Range("A1", "H" & FFimTab).Select ' Seleciona o Range para a cópia dos dados
Selection.Copy ' Copia os dados
Application.CutCopyMode = False ' Remove a seleção de células

' Colar
Workbooks("Orçamento_TesteLista_v2.xltm").Worksheets("ListaProdutos").Activate ' Ativa a pasta de destino
Worksheets("ListaProdutos").Select
Range("A1").Select ' Seleciona a celula ativa
ActiveSheet.Paste ' Cola os dados
' Erro 1004
ActiveWorkbook.Save ' Salva os dados na pasta
Application.CutCopyMode = False ' Remove a seleção de células
End Sub


Erro em tempom de execução 1004 - O método Paste da classe Worksheet falhou.

Eu acompanhei o processo nas duas pastas, tudo ocorre como "previsto", abre a pasta, seleciona a planilha, posiciona o cursor, seleciona a área corretamente. Depois volta para a pasta original, seleciona a planilha certa, posiciona o cursor, na hora do PASTE é que dá o erro.
A única coisa que eu não sei verificar é se está realmente copiando os dados para a área de transferencia.

Agradeço sua atenção e ajuda,

[Reinaldo]

Experimente retirar/inibir a primeira linha ==>"Application.CutCopyMode = False ' Remove a seleção de células"

Código: Selecionar todos

Range("K1").Select ' Seleciona e ativa a celula k1, com Cont.Value
FFimTab = ActiveCell.Value ' Copia o valor da célula para a variável
Range("A1", "H" & FFimTab).Select ' Seleciona o Range para a cópia dos dados
Selection.Copy ' Copia os dados
'Application.CutCopyMode = False ' Remove a seleção de células

[MrcFz]

BINGO!!

Resolveu.

Essa correção tem uma explicação técnica ou foi baseada na experiencia?


De qualquer forma, muito obrigado pela ajuda.