Excel Copiar linha de tabela com macro

[Nilton Cézar]

Olá, pessoal.

Sou leigo em VBA. Por isso, venho recorrer ao conhecimento dos colegas em macro.

Gostaria de uma macro para copiar a linha selecionada (ou ativa) de uma tabela.

 

Acho que seria interessante a macro copiar a linha para baixo da linha ativa.

Detalhe: estou trabalhando com o recurso tabela (e não, intervalo de dados). O nome da tabela é “TabelaRelatório”.
 

Acredito que, após copiar a linha destacada, não é relevante qual linha vai ficar selecionada. Acho que pode ficar a linha inicial mesmo.

Agradeço aos colegas que puderem me ajudar.

[AfonsoMira]

Boas @Nilton Cézar ,
Tem algum modelo que possa disponibilizar?
Obrigado.

 

[Nilton Cézar]

Olá, Afonso.

 

Pelo que entendi, acho que você precisa da planilha, em que consta a tabela.

 

Pois bem, segue em anexo.

 

Para acessar a tabela, basta clicar no link Relatório, em Menu, ou acessar a aba Relatório.

 

Na TabelaRelatório, consta umas shapes (na lateral da tabela), onde pretendo atribuir a macro copiar.

 

Apenas reforçando: macro deve copiar a linha para baixo da linha ativa sem excluir (ou sobrepor) a seguinte.

 

Desde já, agradeço pela ajuda.

 

 

Relatório de Audiências-DEFINITIVO - TESTE.rar

[AfonsoMira]

Então se eu percebi bem, você apenas quer copiar a linha abaixo da linha ativa, certo?

Ou pretendo copiar tudo o que estiver a baixo da linha ativa?

Se for o primeiro caso veja se este funciona:
 

Sub Copy_Click()
    Intersect(ActiveCell.EntireRow.Offset(1, 0), Sheets("Relatório").ListObjects("TabelaRelatório").DataBodyRange).Copy
    ActiveSheet.Range("A1").Select
End Sub

 

[Nilton Cézar]

Olá, Afonso.

 

Estamos quase chegando lá!

 

Citação

Acho que seria interessante a macro copiar a linha para baixo da linha ativa.

 

Acredito que realmente eu não fui muito claro.

 

Pois bem, para facilitar nossa compreensão, vamos chamar a linha resultante da cópia da linha ativa de Linha Clone (foi o que veio à cabeça! ).

 

Então, vejamos:

• Desejo copiar a linha ativa (com os dados);

• A Linha Clone deve surgir abaixo da linha que estava ativa;

• Ficando, na sequência, a Linha Clone selecionada.

• Sem que a linha seguinte seja sobreposta (ou excluída).

Para melhor visualização dessa operação, eu ilustrei esse processo no arquivo em anexo.

 

  A propósito, Afonso, a tabela do meu projeto (TabelaRelatório) contém validação de dados, evento Change, formatação condicional e outras macros vinculadas a ela.

 

Uma dúvida: Esse processo de cópia irá desconfigurar, neutralizar ou excluir algum desses recursos?

 

Mais uma vez, agradeço pela excelente ajuda, Afonso.

 

MACRO COPIAR.pdf

[AfonsoMira]

@Nilton Cézar Veja se é isto que pretende:

Sub Copy_Click()
    Intersect(ActiveCell.EntireRow, Sheets("Relatório").ListObjects("TabelaRelatório").DataBodyRange).Copy
    ActiveCell.Select
    Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Application.CutCopyMode = False
    ActiveSheet.Range("A1").Select
End Sub

 

[Nilton Cézar]

Afonso, fiz os testes e verifiquei o seguinte:

• A macro só está copiando a linha ativa, APENAS se tiverem selecionadas as células da primeira coluna da tabela (coluna C). Nas demais células das outras colunas, é aberto uma janela pop-up de erro (onde aparece as opções FIM e DEPURAR).
• Após o processo de cópia (quando ocorre), a macro está selecionando a célula A1 (com isso, a tabela é jogada lá para baixo). Contudo, gostaria que ficasse selecionada, ao final, a Linha Clone (linha resultante da cópia).
• Outra detalhe que observei: a macro também copia (quando ocorre) a linha ativa fora da tabela (quando tem células selecionada fora dela). Perceba que as macros estão sempre vinculadas à "TabelaRelatório". Da mesma forma, gostaria que a macro em questão fique vinculada apenas à "TabelaRelatório", para evitar cópias fora dela.

 

Afonso, apenas a título de demonstração, vou enviar a macro de Inserir Última Linha (no módulo 2). Ela está atribuída à shape + (em em azul), localizada na lateral da tabela. Ela está vinculada à tabela "TabelaRelatório". Ou seja, ela só insere a (última) linha da tabela, nem uma outra mais.

 

Vejamos: 

 

Sub RelAudRELATÓRIO_InserirLinha()
'Macro para inserir última linha.
    
    Range("TabelaRelatório").ListObject.ListRows.Add AlwaysInsert:=True

End Sub
 

Outro bom exemplo é a macro Excluir Última Linha (no módulo 3), atribuída à shape X (em vermelho), na lateral da tabela. 

______________________

 

Assim, Afonso, fazendo esses ajustes, creio que a macro irá ficar funcionando como esperado.

 

Muita informação, né!

 

Agradeço se puder ajudar.

[Nilton Cézar]

Olá, pessoal.

 

O colega Afonso estava me ajudando, mas acredito que ele não poderá continuar.

 

Sendo assim, venho aqui, mais uma vez, solicitar a ajuda dos colegas, para concluir um projeto.

 

Pois bem, gostaria de uma macro para copiar a linha selecionada (ou ativa) da tabela “TabelaRelatório” (detalhe: não é intervalo de dados; é uma tabela mesmo).

 

Para facilitar, vamos usar a nomenclatura abaixo:

• Linha a ser copiada = linha ativa
• Linha resultante da cópia = Linha Clone

Resumindo, a ideia é a seguinte:

• Desejo copiar a linha ativa da tabela (com os dados), qualquer que seja a célula selecionada nessa linha;
• A Linha Clone deve surgir abaixo da linha que estava ativa;
• Ficando, na sequência, a Linha Clone selecionada.
• Sem que a linha seguinte a que estava ativa seja sobreposta (ou excluída).

A propósito, gostaria que a macro solicitada ficasse vinculada exclusivamente à “TabelaRelatório”, a fim de evitar cópias fora dessa tabela.

 

Se necessário mais informações, é possível verificar nos tópicos anteriores.

 

Segue uma cópia do projeto (para acessar a tabela, basta clicar no link Relatório, em Menu, ou acessar diretamente a aba Relatório).

 

Estou muito ansioso para terminar esse projeto. Por isso, ficaria muito grato que puder me ajudar.

Relatório de Audiências-DEFINITIVO - TESTE.rar

[AfonsoMira]

Boas, @Nilton Cézar

Desde já peço desculpas pela demora em responder, estive uns dias sem computador.

 

Veja se assim já funciona:
 

Sub Copy_Click()

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With

    Intersect(ActiveCell.EntireRow, Sheets("Relatório").ListObjects("TabelaRelatório").DataBodyRange).Copy
    Linha = ActiveCell.Row
    Cells(Linha, 3).Select
    Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Application.CutCopyMode = False
    ActiveSheet.Cells(Linha + 1, 3).Select
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

 

[Nilton Cézar]

Citação

Desde já peço desculpas pela demora em responder, estive uns dias sem computador.

Sem problemas, Afonso.

 

Afonso, fiz uns testes e está abrindo um pop-up de erro com a seguinte descrição:

 

Erro de compilação:

Variável não definida

 

A execução da macro está esbarrando (parando) nessa linha de código:

 

Linha = ActiveCell.Row

 

 

[Midori]

@Nilton Cézar Veja se assim resolve,

 

Sub CopiaLinhaAtiva()
    Dim Linha   As Long
    
    With [TabelaRelatório].ListObject
        Linha = ActiveCell.Row - .DataBodyRange.Row + 2

        .ListRows.Add Linha
        .ListRows(Linha - 1).Range.Copy
        .ListRows(Linha).Range.PasteSpecial
    End With    
    Application.CutCopyMode = False
End Sub

 

[Nilton Cézar]

Obrigado, pessoal, pela pronta ajuda.

 

Midori, está apresentando apenas um pop-up de erro, quando tem alguma célula/linha selecionada abaixo ou acima da TabelaRelatório, ou seja, fora do intervalo da tabela.

 

A mensagem de erro é: SUBSCRITO FORA DO INTERVALO.

 

Inclusive, testando a macro no cabeçalho da tabela, abre a mesma janela de erro.

 

De outra forma, a macro funciona perfeitamente.

 

Mais uma vez, agradeço pela excelente ajuda.

[Midori]

@Nilton Cézar Para evitar a mensagem de erro quando a seleção está fora da tabela,

 

Sub CopiaLinhaAtiva()
    With [TabelaRelatório].ListObject
        If Not Intersect(ActiveCell, .DataBodyRange) Is Nothing Then
            Dim Linha As Long
            
            Linha = ActiveCell.Row - .DataBodyRange.Row + 2
            .ListRows.Add Linha
            .ListRows(Linha - 1).Range.Copy
            .ListRows(Linha).Range.PasteSpecial
            Application.CutCopyMode = False
        End If
    End With
End Sub

 

[Nilton Cézar]

Midori, funcionou perfeitamente!

 

Pelos testes que fiz aqui está tudo OK!

 

A propósito, a tabela do meu projeto (TabelaRelatório) contém validação de dados, evento Change, formatação condicional e outras macros vinculadas a ela.

 

Apenas para afastar qualquer dúvida: Esse processo de cópia pode esconfigurar, neutralizar ou excluir algum desses recursos?

 

Mais uma vez, agradeço pela excelente ajuda.

[Midori]

@Nilton Cézar Essas configurações continuam as mesmas na nova linha.

[Nilton Cézar]

Citação

Essas configurações continuam as mesmas na nova linha.

 

Obrigado, Midori, pelas explicações e pela ajuda.

 

Acredito que agora fechou. Todas as macros de que precisava acho que agora já estão no projeto.

 

Espero que não tenha mais o que fazer! Confesso que não aguento mais! Estou louco para concluir definitivamente o projeto.

 

Obrigado, mais uma vez.

 

Citação

Desde já peço desculpas pela demora em responder, estive uns dias sem computador.

 

Também não posso deixar de te agradecer, Afonso, pela ajuda.

 

Vocês são demais!