Copiar linahs para baixo conforme variavel
Enviado: 04 Jun 2020 às 15:10
Boa tarde! Com a ajuda do AfonsoMira cheguei ate aqui. preciso saber como fazer para depois de selecionado as celulas que quero copiar que o sistema copie o mesmo tanto de linhas guardado na VarLinha. ]
Codigo: Até onde esta em vermelho ela funciona bem . No final (coloquei varios ###### para localizarem) é onde preciso de ajuda. na planilha em anexo a VarLinha é igual a 9, então preciso copiar esta linha selecionada 9 vezes.
espero ter sido claro na minha duvida.
Abraços.
Codigo: Até onde esta em vermelho ela funciona bem . No final (coloquei varios ###### para localizarem) é onde preciso de ajuda. na planilha em anexo a VarLinha é igual a 9, então preciso copiar esta linha selecionada 9 vezes.
espero ter sido claro na minha duvida.
Abraços.
Código: Selecionar todos
Sub Macro1()
'Verifica quantas linhas ate Equip
varColuna = 1 ' Coluna que será verificado
VarLinha = 1 ' Linha inicial que será verificado
varConteudo = 1
Do While varConteudo < 10000 'continua a verificar se conteudo for diferente de vazio
VarLinha = VarLinha + 1 'contador de linha
varConteudo = Cells(VarLinha, varColuna).Value 'grava o valor da celula
Loop
MsgBox "A qtde. de linhas é: " + CStr(VarLinha - 1)
ActiveWorkbook.Worksheets("Planilha_Ed").Columns(1).Find("Equip.").Select
ActiveCell.Offset(0).EntireRow.Insert
ActiveCell.Offset(2, 0).Select
'********Termina a contagem de linhas de Pessoal
varColuna1 = 1 ' Coluna que será verificado
varLinha1 = VarLinha + 2 ' Linha inicial que será verificado
varConteudo1 = 1
Do While varConteudo1 <> Empty 'continua a verificar se conteudo for diferente de vazio
varLinha1 = varLinha1 + 1 'contador de linha
varConteudo1 = Cells(varLinha1, varColuna1).Value 'grava o valor da celula
Loop
MsgBox "A qtde. de linhas é: " + CStr(varLinha1 - 2 - VarLinha)
Worksheets("Planilha ED1").Activate
ActiveWorkbook.Worksheets("Planilha ED1").Columns(1).Find("Pessoal").Select
ActiveCell.Offset(2, 0).Select
For nCol = 1 To VarLinha - 1
Cells(VarLinha, 1).EntireRow.Insert
Next nCol
[color=#FF0000]MsgBox "Quero copiar o mesmo valor de VarLinha para baixo'"[/color][/size][/color]
[color=#FF0000]ActiveCell.Offset(0, 0).Resize(1, 18).Select
ActiveCell.Copy[/color]
#######################################
ActiveCell.Offset(VarLinha, 0).Select
'Cells(VarLinha + 1, 1).EntireRow.Insert
'ActiveCell.Offset(VarLinha).EntireRow.Insert
End Sub