Import data from and old sheet to an actual sheet, but the macro button from the old sheet is getting copy to, but I can´t remove it

55 views Asked by At

I need to import data from an old sheet (Planilha Teste 1 VBA) to an actual sheet (Pasta teste para importar dados de outra planilha), but the macro button (CADASTRAR) from the old sheet is getting copy too and I don´t know how to solve it. The VBA code that I am using is this:

Sub ImportarDados()
    Dim wb As Workbook 'declara uma variável para o arquivo que será aberto
    Dim planilhaAtual As Worksheet 'declara uma variável para a planilha atual
    Dim planilhaDados As Worksheet 'declara uma variável para a planilha de origem (dados)
    Dim caminhoArquivo As String 'declara uma variável para o caminho do arquivo
    Dim arquivoSelecionado As Variant 'declara uma variável para armazenar o nome do arquivo selecionado
    
    'Mostra uma janela para que o usuário selecione o arquivo externo
    arquivoSelecionado = Application.GetOpenFilename("Arquivos do Excel (.xlsx;.xlsm),.xlsx;.xlsm")
    
    'Se o usuário selecionar um arquivo, carrega o caminho do arquivo no módulo VBA
    If arquivoSelecionado <> False Then 'verifica se o usuário selecionou um arquivo
        caminhoArquivo = arquivoSelecionado 'armazena o caminho do arquivo selecionado
        
        'Abre o arquivo selecionado
        Set wb = Workbooks.Open(caminhoArquivo)
    
        'Defina a planilha atual (onde o código VBA está sendo executado)
        Set planilhaAtual = ThisWorkbook.ActiveSheet 'define a planilha atual como a ativa
    
        'Extrai o nome da planilha de origem
        Set planilhaDados = wb.Worksheets(1) 'Assumindo que a planilha de origem é a primeira na lista
        Dim nomePlanilha As String 'declara uma variável para armazenar o nome da planilha de origem
        nomePlanilha = planilhaDados.Name 'armazena o nome da planilha de origem
        
        'Extrai o intervalo de dados da planilha de origem
        Dim intervaloDados As Range 'declara uma variável para o intervalo de dados
        Set intervaloDados = planilhaDados.Range("A1:BB200") 'Altere o intervalo conforme necessário
        
       For Each obj In planilhaDados.Shapes 'percorre cada objeto (forma) na planilha de origem
    If obj.Type = msoOLEControlObject Then 'verifica se é um botão de comando
        If Not obj.OLEFormat.Object.Name = "CADASTRAR" Then 'verifica se o botão não é o botão da macro original
            obj.Delete 'exclui o botão de comando
        End If
    Else
        obj.Copy 'copia os outros objetos
        planilhaAtual.Paste 'cola os outros objetos na planilha atual
    End If
Next obj

        
        intervaloDados.Copy planilhaAtual.Range("A1") 'copia o intervalo de dados para a planilha atual
    
        'Feche o arquivo que você importou os dados
        wb.Close False 'fecha o arquivo sem salvar
        
        'Mostra uma mensagem informando o nome da planilha de origem e o caminho do arquivo
        MsgBox "Os dados foram importados da planilha " & nomePlanilha & " no arquivo " & caminhoArquivo & "."
    
    End If
    
End Sub

The first image is from the old sheet and the macro button "CADASTRAR"

The second image is from the actual sheet after I hit the "ATUALIZAR" button on it to import the data from the old sheet, and then the macro button "CADASTRAR" from the ols sheet get paste.

I tried many times change this lines of code but didn´t get the result I expected

For Each obj In planilhaDados.Shapes 'percorre cada objeto (forma) na planilha de origem
    If obj.Type = msoOLEControlObject Then 'verifica se é um botão de comando
        If Not obj.OLEFormat.Object.Name = "CADASTRAR" Then 'verifica se o botão não é o botão da macro original
            obj.Delete 'exclui o botão de comando
        End If
    Else
        obj.Copy 'copia os outros objetos
        planilhaAtual.Paste 'cola os outros objetos na planilha atual
    End If
Next obj
1

There are 1 answers

1
Tim Williams On

If you don't want shapes/objects to copy with a range:

Application.CopyObjectsWithCells = False
intervaloDados.Copy planilhaAtual.Range("A1")
Application.CopyObjectsWithCells = True