Como copiar solo celdas con contenido

Estimados soy nuevo en el foro y el mundo de las macros

Me gustaria pedir ayuda en la macro.

La macro copia y pega un rango, pero adicional a eso quiero que solo copie las celdas del rango con contenido, hasta ahora me copia el rango completo.

Adicional me gustaria su ayuda en asignar dos modulos de macro a un boton

Les adjunto elcodigo.

Sub CopiarCeldas()
'Definir objetos a utilizar
Dim wbDestino As Workbook, _
    wsOrigen As Excel.Worksheet, _
    wsDestino As Excel.Worksheet, _
    rngOrigen As Excel.Range, _
    rngDestino As Excel.Range
'Indicar el libro de Excel destino
Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "\CONSOLIDADO VALES.xlsx")
'Activar este libro
ThisWorkbook.Activate
'Indicar las hojas de origen y destino
Set wsOrigen = Worksheets("GUIA")
Set wsDestino = wbDestino.Worksheets("CONSOLIDADO")
'Indicar la celda de origen y destino
Const celdaOrigen = "A7:G24"
Const celdaDestino = "A1"
'Inicializar los rangos de origen y destino
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
'Seleccionar rango de celdas origen
rngOrigen.Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Pegar datos en celda destino
rngDestino.Insert Shift:=xlDown
Application.CutCopyMode = False
'Guardar y cerrar el libro de Excel destino
wbDestino.Save
wbDestino.Close
End Sub

AGRADECIDO DESDE YA.