Página 1 de 1
Inserir linhas intercaladas e em loop
Enviado: 29 Mai 2020 às 10:32
por 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
Re: Inserir linhas intercaladas e em loop
Enviado: 29 Mai 2020 às 11:09
por 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.
Inserir linhas intercaladas e em loop
Enviado: 29 Mai 2020 às 11:18
por 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
Inserir linhas intercaladas e em loop
Enviado: 29 Mai 2020 às 11:31
por AfonsoMira
Ora veja se com essa macro tem o resultado que pretende:
Código: Selecionar todosSub 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.
Inserir linhas intercaladas e em loop
Enviado: 29 Mai 2020 às 11:36
por 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 todosSub 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