VBA - Copiar e colar vários lançamentos dentro de várias linhas ignorando espaços em branco.

Question

Olá, galera! Tudo bem? Espero que sim. 

Preciso de uma grande ajuda de vocês...vamos lá! 

Eu tenho uma planilha que contém uma aba de lançamentos contábeis de 21 empresas. 

Vocês teriam um código de VBA pra me ajudar a copiar e colar os lançamentos automaticamente de todas as empresas? 

A ideia seria o código passar pela lista do número de cada empresa, copiar os lançamentos e colar a partir da linha 42. 

Por exemplo: 

(Segue o Print).

Quando ele copiar e colar esses lançamentos na linha 42, a próxima empresa ele já não poderia colar na mesma linha, aí já seria a partir da linha 51 e assim sucessivamente. 

Outra coisa também, nos lançamentos, na linha 2 até a 40 tem fórmula, ou seja, algumas coisas aparecem e outras não. 

O código que eu tentei ficava puxando todo o intervalo com as informações e o que estava em branco, mas era por causa da fórmula. 

Poderiam me ajudar, por favor? 

Answer 1

Segue a planilha com o código atualizado. https://we.tl/t-G9EM9NK7Qe

O código ajustado ficará conforme abaixo:

Sub Macro1()

Application.ScreenUpdating = False

Dim empresa As Integer

Dim Linha As Integer

Dim Contador As Integer

Dim Preenchidas As Integer

Contador = ActiveSheet.Range("AH1").Value

Linha = 42

Range("AH1").Value = 0

For empresa = 1 To 21

Range("AH1").Value = Range("AH1").Value + 1

Preenchidas = Application.WorksheetFunction.CountA(Range("A2:A40")) - WorksheetFunction.CountBlank(Range("A2:A40"))

'Seleciona e copia apenas células visíveis dentro do intervalo A2:J40

ActiveSheet.Range("A2:J" & Preenchidas + 1).Select

Selection.Copy

'Selecionar a célula A42

Range("A42").Select

'Procurar a primeira célula vazia

Do

If Not (IsEmpty(ActiveCell)) Then

  ActiveCell.Offset(1, 0).Select 

End If

Loop Until IsEmpty(ActiveCell) = True

'Cola as informações na primeira célula vazia encontrada 

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

Next empresa

Application.CutCopyMode = False

Range("A1").Select

Application.ScreenUpdating = True

End Sub

Atenciosamente,

Hermes Santos

Answer 2

Excelenteeee!!! Muitíssimo obrigadoo mesmo, Hermes!!

Ficou excelente!! Era exatamente o que eu precisava!!

Gratidão mesmo!! 10 estrelas pra você!

Att,

Answer 3

Olá Cassio,

Por gentileza, teste este outro código que adaptei. Se não lhe atender, tente postar sua planilha no OneDrive e compartilhar o link por aqui. Acredito que informar endereços de e-mail pode infringir as regras da Comunidade (não tenho certeza sobre isto).

Sub Macro1()

Application.ScreenUpdating = False

Dim empresa As Integer

Dim Linha As Integer

Dim Contador As Integer

Dim IntervaloCopia As Range

Set IntervaloCopia = ActiveSheet.Range("A2").CurrentRegion

ActiveSheet.Range("AH2").Value = 0

Linha = 42

For empresa = 1 To 21

IntervaloCopia.Offset(1, 0).Resize(IntervaloCopia.Rows.Count - 1, IntervaloCopia.Columns.Count).Select

Selection.Copy

'Selecionar a célula A42

Range("A42").Select

'Procurar a primeira célula vazia

Do

If Not (IsEmpty(ActiveCell)) Then

  ActiveCell.Offset(1, 0).Select 

End If

Loop Until IsEmpty(ActiveCell) = True

'Cola as informações na primeira célula vazia encontrada 

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks \_ 

    :=False, Transpose:=False 

Range("AH2").Value = Range("AH2").Value + 1

Linha = Linha + 9

Next empresa

Application.CutCopyMode = False

Range("A1").Select

Application.ScreenUpdating = True

End Sub

Answer 4

Hermes, bom dia.

Primeiramente, muito obrigado pelo retorno.

Seria possível eu te enviar essa planilha para você verificar o que está acontecendo?

Acredito que seja uma coisa bem rápida.

O código funcionou para copiar, porém, ele está copiando junto com as fórmulas e não aparece nada.

Outro ponto é que cada empresa tem uma quantidade de lançamentos variáveis, ou seja, percebi no código que você especificou um intervalo de Range("A2:J10").Select porém cada empresa pode variar até a célula J40.

Ou seja, você teria um jeito dele pegar somente os lançamentos visíveis e ignorar as células vazias (mesmo com fórmulas)?

Answer 5

Olá Cassio,

Com base nas informações que você forneceu, desenvolvi o código abaixo. Por gentileza, teste e veja se lhe atende

Sub Macro1()

Application.ScreenUpdating = False

Dim empresa As Integer

Dim Linha As Integer

Dim Contador As Integer

ActiveSheet.Range("AH2").Value = 0

Linha = 42

For empresa = 1 To 21

Range("A2:J10").Select 

Selection.Copy 

'Selecionar a célula A42

Range("A42").Select

'Procurar a primeira célula vazia

Do

If Not (IsEmpty(ActiveCell)) Then

  ActiveCell.Offset(1, 0).Select 

End If

Loop Until IsEmpty(ActiveCell) = True

'Cola as informações na primeira célula vazia encontrada 

ActiveSheet.Paste 

Range("AH2").Value = Range("AH2").Value + 1

Linha = Linha + 9

Next empresa

Application.CutCopyMode = False

Range("A1").Select

Application.ScreenUpdating = True

End Sub