Este fórum está sendo desativado

[Alexmanza]

Bom dia!
como poderia montar esse comando para que realize a inserção de linhas até o final da planilha somente onde apresentar conteúdo.
não consegui montar o while
Sub Macro7()
'
' Macro7 Macro
'

'
Range("A2").Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Rows("2:2").RowHeight = 3

End Sub

o arquivo segue em anexo

[AfonsoMira]

Boas ora a ideia seria adicionar um linha de 2 em 2 e diminuir o tamanho dessa mesma linha certo?

Queria que a macro fizesse isso até ao final da folha ou até que a célula A deixasse de apresentar conteúdo?

Obrigado.

[Alexmanza]

Boas ora a ideia seria adicionar um linha de 2 em 2 e diminuir o tamanho dessa mesma linha certo?
Sim isso mesmo, eu vi em tutoriais já montei boa parte da automação, mas enrosquei nessa fase do loop
Queria que a macro fizesse isso até ao final da folha ou até que a célula A deixasse de apresentar conteúdo?
Gostaria que fizesse até o final da célula "A", porque todo mes aumenta pessoas e ai ela já buscaria automaticamente, estava tentado usar correalçao com linha, tipo :linha_fim = Range("J1").End(xlDown).Row

While linha <= linha_fim
mas não consegui terminar a relação para que ela entrasse no loop inserindo as linhas

[AfonsoMira]

Ora veja se com essa macro tem o resultado que pretende:

Código: Selecionar todos

Sub adicona_linha()

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim ultima_linha As Long

Dim i As Long

'desde a linha 2 até a ultima de 2 em 2 linhas
For i = 2 To 10000 Step 2

If Rows(i).RowHeight = 3 Then

'caso a linha já tenha 3 de altura não faz nada

Else

'caso contrário irá formatar a linha

Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows(i).RowHeight = 3

End If

Next i

MsgBox "Terminou a macro"

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Ela irá fazer até a linha 10000 mas podemos alterar se quiser.

Alguma dúvida é só chamar.

[AfonsoMira]

Fiz uma pequena alteração na macro que enviei anteriormente.
Agora em vez de fazer até à linha 10000, faz apenas até a ultima linha preenchida na coluna A.

Código: Selecionar todos

Sub adicona_linha()

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim ultima_linha As Long

inicio:

ultima_linha = Range("A10000").End(xlUp).Row

Dim i As Long

'desde a linha 2 até a ultima de 2 em 2 linhas
For i = 2 To ultima_linha + 2 Step 2

If Rows(i).RowHeight = 3 Then

'caso a linha já tenha 3 de altura não faz nada

Else

'caso contrário irá formatar a linha

Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows(i).RowHeight = 3

GoTo inicio

End If

Next i

MsgBox "Terminou a macro"

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub