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

[leo.mb]

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.