Este fórum está sendo desativado

[andriessen]

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.

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

[andriessen]

Bom dia! Consegui resolver com o NEXT. Obrigado

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 i = 1 To VarLinha - 1

ActiveCell.Offset(0, 0).Resize(1, 18).Select
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown

Next i

End Sub