Copiar várias célul...
 
Notifications
Clear all

Copiar várias células para dentro de uma só com quebra de L

3 Posts
2 Usuários
0 Reactions
743 Visualizações
(@leo-mb)
Posts: 0
New Member
Topic starter
 

Bom dia pessoal, sou novo na utilização do VBA e não sei legal a utilização do loop

Fiz um código para copiar vária células (Planilha Maio (1)coluna B da linha 4 para baixo) e colar dentro de uma única com quebra de página(Planilha Maio Célula B7), só que eu quero que copia somente as células que tem conteúdo, fiz do Range B4:B10 de uma forma muito manual, queria aumentar esse range de uma forma automática, segue abaixo o que eu fiz:

Sub ()

Sheets("Maio").Activate
Range("B7").Select

If Sheets("Maio (1)").Range("B10") <> "" Then
ActiveCell.Value = Sheets("Maio (1)").Range("B4") & vbCrLf & Sheets("Maio (1)").Range("B5") _
& vbCrLf & Sheets("Maio (1)").Range("B6") & vbCrLf & Sheets("Maio (1)").Range("B7") _
& vbCrLf & Sheets("Maio (1)").Range("B8") & vbCrLf & Sheets("Maio (1)").Range("B9") _
& vbCrLf & Sheets("Maio (1)").Range("B10")


ElseIf Sheets("Maio (1)").Range("B9") <> "" Then
ActiveCell.Value = Sheets("Maio (1)").Range("B4") & vbCrLf & Sheets("Maio (1)").Range("B5") _
& vbCrLf & Sheets("Maio (1)").Range("B6") & vbCrLf & Sheets("Maio (1)").Range("B7") _
& vbCrLf & Sheets("Maio (1)").Range("B8") & vbCrLf & Sheets("Maio (1)").Range("B9")

ElseIf Sheets("Maio (1)").Range("B8") <> "" Then
ActiveCell.Value = Sheets("Maio (1)").Range("B4") & vbCrLf & Sheets("Maio (1)").Range("B5") _
& vbCrLf & Sheets("Maio (1)").Range("B6") & vbCrLf & Sheets("Maio (1)").Range("B7") _
& vbCrLf & Sheets("Maio (1)").Range("B8")


ElseIf Sheets("Maio (1)").Range("B7") <> "" Then
ActiveCell.Value = Sheets("Maio (1)").Range("B4") & vbCrLf & Sheets("Maio (1)").Range("B5") _
& vbCrLf & Sheets("Maio (1)").Range("B6") & vbCrLf & Sheets("Maio (1)").Range("B7")


ElseIf Sheets("Maio (1)").Range("B6") <> "" Then
ActiveCell.Value = Sheets("Maio (1)").Range("B4") & vbCrLf & Sheets("Maio (1)").Range("B5") _
& vbCrLf & Sheets("Maio (1)").Range("B6")


ElseIf Sheets("Maio (1)").Range("B5") <> "" Then
ActiveCell.Value = Sheets("Maio (1)").Range("B4") & vbCrLf & Sheets("Maio (1)").Range("B5")


ElseIf Sheets("Maio (1)").Range("B4") <> "" Then
ActiveCell.Value = Sheets("Maio (1)").Range("B4")


End If

End Sub

Se alguém puder ajudar agradeço.

 
Postado : 14/05/2018 8:35 am
(@xlarruda)
Posts: 0
New Member
 

Nosso Colega fernando.fernandes já apresentou uma solução anteriromente em um tópico:

Segue:

http://www.planilhando.com.br/forum/viewtopic.php?f=21&t=19711

Em anexo, segue uma planilha com o código na prática:

 
Postado : 14/05/2018 10:35 am
(@leo-mb)
Posts: 0
New Member
Topic starter
 

Talvez eu não tenha explicado direito, mas a function ali não atende ou eu não estou sabendo adaptar.
Eu preciso quebra a linha entre uma célula e outra, não se é possível substituir o delimitador pela quebra de linha, eu não consegui.

 
Postado : 15/05/2018 12:23 pm