Jump to content
Fórum Script Brasil
  • 0

Não copia Tabela para a Pasta Dados


Question

Srs., Boa Tarde!

Estou iniciando com programação VBA.
Peço a ajuda dos colegas para analisar o código e ver o erro.
O código é executado sem erro, mas os dados da tabela origem não é copiado pro destino (Planilha 'Dados')

Agradeço quem puder me ajudar.

 

Sub lsExpandirDados()
    On Error GoTo Sair
    
    Dim lPlanCriada As String
    Dim lPlanilhaOriginal As String

    'Captura o nome da planilha aonde está a tabela dinâmica
    lPlanilhaOriginal = ActiveSheet.Name & "!" & ActiveCell.Address

    'Desabilita mostrar alertas de mostrar mensagens de erro
    Application.DisplayAlerts = False

    'Limpa a planilha dados
    Sheets("Dados").Range("A:XFD").Clear

    'Abre os detalhes do registro da tabela dinâmica
    Selection.ShowDetail = True

    'Guarda o nome da planilha criada
    lPlanCriada = ActiveSheet.Name
    
    'Copia os dados abertos
    Selection.Copy
    
    'Cola as informações na tabela dados
    Sheets("Dados").Select
    Sheets("Dados").Cells(1, 1).Activate
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
    'Exclui a planilha criada
    Worksheets(lPlanCriada).Delete
        
    'Organiza as colunas
    Selection.EntireColumn.AutoFit
    Worksheets("Dados").Range("B2").Select
    ActiveWindow.FreezePanes = True
    
    
    Worksheets("Dados").Range("A1").Select
    Selection.End(xlToRight).Select
    
    Worksheets("Dados").Cells(1, ActiveCell.Column + 2).Select
    
     ActiveCell.Value = "Voltar"
    
    'Cria o hiperlink
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        lPlanilhaOriginal, TextToDisplay:="Voltar"
        
        Worksheets("Dados").Activate
    Range("E5").Activate
        
Sair:

End Sub

Edited by Paulo Andrade
Link to post
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Cloud Computing


  • Forum Statistics

    • Total Topics
      148681
    • Total Posts
      644506
×
×
  • Create New...