Option Explicit
Sub InsereBloco()

Dim Bloco As Range
Dim lDestino As Range
'Dim lFinal As Integer
'Dim cFinal As Integer

ActiveSheet.Unprotect

'Application.Calculation = xlCalculationManual

On Error Resume Next
Set Bloco = Application.InputBox("Por favor, digite o intervalo: ", Type:=8)
On Error GoTo 0

If Bloco Is Nothing Then
MsgBox "O intervalo foi cancelado"
Else
MsgBox "O intervalo selecionado é:" & Bloco.Address
Bloco.Select
Selection.Copy
End If

On Error Resume Next
Set lDestino = Application.InputBox("Digite a linha de DESTINO:", Type:=8)
On Error GoTo 0

If lDestino Is Nothing Then
MsgBox "O intervalo foi cancelado"
Else
MsgBox "O intervalo selecionado é:" & lDestino.Address

Bloco.Select
Selection.Copy
With lDestino

.Insert 'Shift:=xlDown
End With
Application.CutCopyMode = False
End If

Application.Calculation = xlCalculationAutomatic

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingRows:=True, AllowSorting:=True, _
AllowFiltering:=True

End Sub

Editado pela Moderação. Motivo: Utilize o botão Código (< >) sempre que for inserir código VBA ou Fórmulas.

Anderson, boa tarde.

Agradeço seu auxílio. Por detalhe errei no código.

Se não for abusar de sua disposição, gostaria de outro auxílio.

Conforme o código acima, é feita uma inserção de bloco, empurrando todo o conjunto para baixo e, na necessidade de uma nova inserção, o código deverá ser rodado novamente, com a seleção do bloco a ser inserido.

Como esse bloco é sempre o mesmo, desenvolvi o Módulo2, no arquivo incluso, para substituir a seleção manual do bloco, porém, ele não está inserindo todo o bloco no destino, apenas uma linha.

Com o código acima, ele insere normalmente toda a área.

Novamente me socorro dos colegas: onde está o erro, uma vez que o bloco selecionado é o mesmo e a rotina de copiar e inserir segue o mesmo padrão do código acima?

Agradeço antecipadamente.

@bautto aqui esta dando que o arquivo esta corrompido.

@teleguiado, bom dia.

Não sei o que houve, aqui abri normalmente o arquivo zipado.

Estou colocando o arquivo .xlsm, reduzido, pois o original é bastante grande.

Agradeço a atenção.

Colegas, boa noite.

Ainda não consegui encontrar o ponto onde estou errando no código do Módulo2, que faz com que o bloco selecionado não seja copiado no local indicado... Algum dos mestres pode auxiliar-me a identificar a falha?

Agradeço antecipadamente.

@bautto O código que o Anderson passou funciona normalmente, o seu código acredito que não esteja funcionando porque perde a referencia do Bloco quando executo a 2 macro(Inserirbloco).

Inseri no seu arquivo original com o código do Anderson a função de deletar o bloco que você escolher.

teleguiado, bom dia.

Agradeço seu interesse. 

Talvez não tenha esclarecido adequadamente minha dificuldade. É a seguinte:

O Módulo1, funciona corretamente, com a correção feita pelo Anderson.

A dificuldade que coloquei é com relação ao Módulo2.

A parte inicial do Módulo1, pede para o usuário selecionar o bloco de 25 linhas existente ao final da planilha, para inserir em local que seja necessário um número maior de linhas que as 6 dos blocos "padrão".

Inserindo esse bloco, o que está no final da planilha muda de posição e, se necessária nova inserção, o usuário terá que selecionar novamente, por digitação ou utilização do mouse, o que pode gerar erro.

Com o Módulo2, minha intenção foi de automatizar essa seleção, uma vez que o tamanho é sempre o mesmo, mudando apenas sua posição na planilha. A rotina do Módulo2 faz isso.

Entretanto, esse bloco selecionado pela rotina do Módulo2 não é inserido corretamente no local indicado, sendo acrescentada apenas uma linha, e, mesmo assim, sem as fórmulas do bloco selecionado.

Não consegui identificar a causa desse comportamento diferente, entre a seleção feita na rotina do Módulo1, manualmente e do Módulo2, automaticamente.

Se executar o Módulo1, verá o funcionamento desejado da rotina.

Desabilitando as linhas 13 a 24 do Módulo1, (que seleciona o bloco) e rodando o Módulo2, que depois de selecionar automaticamente o bloco, chama a sequência no Módulo1, vai ver que a inserção não ocorre como desejado.

Estou anexando novamente o arquivo, com os dois Módulos.

Agradeço sua atenção.

@bautto como disse no outro post acredito que o problema da sua macro esteja justamente em separar a execução em 2 módulos, quando o módulo2 é inserido dentro da rotina do módulo 1 faz justamente o que você precisa. 😊 

Ja que o módulo 2 é automático é so retirar do módulo 1 a opção do usuário escolher o que deseja copiar. 😉 

Não sei é do jeito que você queria, veja se o código abaixo te ajuda. Talvez alguém possa melhorar o que sugeri no código.

Sub InsereBloco()

Dim lastRow As Long, lastCol As Long
Dim firstRow As Long
Dim Bloco As Range
Dim lDestino As Range
Dim BlocDel As Range

ActiveSheet.Select
ActiveSheet.Unprotect
'Application.Calculation = xlCalculationManual

'On Error Resume Next
' Set Bloco = Application.InputBox("Selecione o BLOCO a ser Copiado. Clique na LINHA INICIAL: ", _
' Title:="INSERIR BLOCO", Type:=8)
'On Error GoTo 0
lastCol = ActiveSheet.Cells(5, Columns.Count).End(xlToLeft).Column
firstRow = Cells(Rows.Count, lastCol).End(xlUp).Row
lastRow = firstRow + 25

Set Bloco = Range(Cells(firstRow, 1), Cells(lastRow, lastCol)) '.Select

'Bloco.Select
'Selection.Copy

'If Bloco Is Nothing Then
' MsgBox "O intervalo foi cancelado"
'Else
' MsgBox "O BLOCO selecionado é: " & Bloco.Address
'End If
' Bloco.Select
' Selection.Copy

On Error Resume Next
Set lDestino = Application.InputBox("Digite o LOCAL DE DESTINO: Clique na CÉLULA DE DESTINO", _
Title:="DESTINO DO BLOCO", Type:=8)
On Error GoTo 0

If lDestino Is Nothing Then
MsgBox "O intervalo foi cancelado"
Else
MsgBox "O DESTINO selecionado é: " & lDestino.Address
Bloco.Select
Selection.Copy
With lDestino
.Insert 'xlShiftDown

End With
Application.CutCopyMode = False
Range("A1").Select
End If

On Error Resume Next
Set BlocDel = Application.InputBox("Digite o BLOCO a DELETAR: Clique na LINHA INICIAL ", _
Title:="DELETAR BLOCO", Type:=8)
On Error GoTo 0

If BlocDel Is Nothing Then
MsgBox "O intervalo foi cancelado"
Else
MsgBox "O BLOCO a DELETAR é: " & BlocDel.Address
With BlocDel
.Delete
End With
End If

MsgBox "ATENÇÃO!! CORRIJA AS FÓRMULAS ALTERADAS!", vbExclamation, Title:="ATENÇÃO!!"

Application.Calculation = xlCalculationAutomatic

ActiveSheet.Protect _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=True, _
AllowSorting:=True, _
AllowFiltering:=True

End Sub

teleguiado, bom dia.

Mais uma vez agradeço seu interesse.

Ainda ontem, refiz as rotinas e consegui executar corretamente.

Realmente não sei o que ocorreu, mas ficou mesmo como você sugeriu acima.

Se observar o que tem no Módulo1 no anexo da minha postagem do dia 01/09, vai ver que nele tinha a rotina de determinação e seleção automática do bloco (que está comentado), mas naquele momento não funcionou.

Ainda não sei se tinha algum bug, ou era o "operador" (eu), quem estava falhando.

Grato por sua atenção e ajuda.

@bautto nesse arquivo do dia 01-09 a macro não esta igual ao que o Anderson sugeriu.

Esta faltando a parte de copiar o bloco antes do With lDestino

Sub InsereBloco()

'Dim lastRow As Long, lastCol As Long
'Dim firstRow As Long, firstCol As Long
'Dim Bloco As Range
Dim lDestino As Range
Dim BlocDel As Range

'ActiveSheet.Select
ActiveSheet.Unprotect
'Application.Calculation = xlCalculationManual

'On Error Resume Next
' Set Bloco = Application.InputBox("Selecione o BLOCO a ser Copiado. Clique na LINHA INICIAL: ", _
' Title:="INSERIR BLOCO", Type:=8)
'On Error GoTo 0
'
'If Bloco Is Nothing Then
' MsgBox "O intervalo foi cancelado"
'Else
' MsgBox "O BLOCO selecionado é: " & Bloco.Address
'End If
' Bloco.Select
' Selection.Copy
'lastCol = ActiveSheet.Cells(5, Columns.Count).End(xlToLeft).Column
'lastRow = Cells(Rows.Count, lastCol).End(xlUp).Row + 25
'firstCol = lastCol - 23
'firstRow = Cells(Rows.Count, lastCol).End(xlUp).Row
'
'Bloco = Range(Cells(firstRow, firstCol), Cells(lastRow, lastCol)).Select

On Error Resume Next
Set lDestino = Application.InputBox("Digite o LOCAL DE DESTINO: Clique na CÉLULA DE DESTINO", _
Title:="DESTINO DO BLOCO", Type:=8)
On Error GoTo 0

If lDestino Is Nothing Then
MsgBox "O intervalo foi cancelado"
Else
MsgBox "O DESTINO selecionado é: " & lDestino.Address

'AQUI ESSA PARTE NÃO TINHA NO SEU CÓDIGO
 Bloco.Select
 Selection.Copy


With lDestino
.Insert
Application.CutCopyMode = False
End With
Range("A1").Select
End If

On Error Resume Next
Set BlocDel = Application.InputBox("Digite o BLOCO a DELETAR: Clique na LINHA INICIAL ", _
Title:="DELETAR BLOCO", Type:=8)
On Error GoTo 0

If BlocDel Is Nothing Then
MsgBox "O intervalo foi cancelado"
Else
MsgBox "O BLOCO a DELETAR é: " & BlocDel.Address
With BlocDel
.Delete
End With
End If

MsgBox "ATENÇÃO!! CORRIJA AS FÓRMULAS ALTERADAS!", vbExclamation, Title:="ATENÇÃO!!"

Application.Calculation = xlCalculationAutomatic

ActiveSheet.Protect _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=True, _
AllowSorting:=True, _
AllowFiltering:=True

End Sub

Mais uma vez, obrigado.