How about this
[VBA]Sub test()
Dim sourceRange As Range
Dim destinationRange As Range
Dim arrTemp As Variant

Set sourceRange = Worksheets("Monthly Source").Range("C400:C5582")
Set destinationRange = Sheets("Monthly Source").Range("G4:G161")
Set sourceRange = Sheet1.Range("A1:A15")
Set destinationRange = Sheet1.Range("Q2")

With sourceRange
Set destinationRange = destinationRange.Resize(.Rows.Count, .Columns.Count)
End With

With destinationRange
.Value = sourceRange.Value
On Error Resume Next
.SpecialCells(xlCellTypeConstants, xlErrors).ClearContents
On Error GoTo ErrorOut

If .Cells(1, 1) = vbNullString Then
With .SpecialCells(xlCellTypeConstants).Areas(1)
arrTemp = .Value
.ClearContents
destinationRange.Resize(.Rows.Count, 1).Value = arrTemp
End With
End If

Do While 1 < .SpecialCells(xlCellTypeConstants).Areas.Count
With .SpecialCells(xlCellTypeConstants).Areas(2)
arrTemp = .Value
.ClearContents
destinationRange.SpecialCells(xlCellTypeBlanks).Cells(1, 1).Resize(.Rows.Count, 1).Value = arrTemp
End With
Loop
End With

ErrorOut:
On Error GoTo 0
End Sub[/VBA]