inserir copiando

2024 - VBA & Macros

Post Recente por Fernando Fernandes 7 anos atrás

3 Posts

2 Usuários

0 Reactions

685 Visualizações

RSS

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Topic starter

Senhores, bom dia.
Por gentileza, poderiam me ajudar?
Gostaria de inserir um inputbox para que a rotina abaixo rodasse de acordo com o número de linhas desejado.

Da forma que ela está as linhas são copiadas uma a uma. Se possível eu gostaria de altera la.

Sub AdicionaLinhaDuploClique()

    Aux1 = Selection.Row

    Rows(Aux1 + 1).Insert Shift:=xlDown

    Range("A" & Aux1 & ":H" & Aux1).Copy

    Range("A" & Aux1 + 1).Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Range("A" & Aux1 + 1).Select

End Sub

Muitíssimo obrigado a todos.

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 06/10/2017 11:20 pm

xlarruda

(@xlarruda)

Posts: 732

Honorable Member

Sub AdicionaLinhaDuploClique()
Application.ScreenUpdating = False
Dim qtd As Integer
qtd = Application.InputBox("Quantas linhas abaixo?", "Quantidade")
For i = 1 To qtd
Aux1 = Selection.Row

Rows(Aux1 + 1).Insert Shift:=xlDown

Range("A" & Aux1 & ":H" & Aux1).Copy

Range("A" & Aux1 + 1).Select

ActiveSheet.Paste

Application.CutCopyMode = False

Range("A" & Aux1 + 1).Select

Next i
Application.ScreenUpdating = True

End Sub

Segue exemplo em anexo
Abç!

___________________________________________________________________________________________
Se a resposta atendeu sua dúvida, por favor, clique no Gostei e marque o Tópico como [Resolvido].

Att.

André Arruda

Postado : 07/10/2017 6:33 am