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.