Copying from from one range to another ignoring blanks (Excel) - excel

Question

I'm trying to copy a range from one sheet to another, but ignoring blank rows, and making sure there aren't blank rows in the destination.
After looking on this site, I've successfully used the code below.
However, I want to expand this to a large data range and it seems to take an absolute age. Any ideas on a more efficient code? Slight newbie here!
Thanks!
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Dim Source As Worksheet
Dim Destination As Worksheet
Dim i As Integer
Dim j As Integer
Set Source = Sheet1
Set Destination = Sheet4
j = 2
For i = 9 To 10000
If Source.Cells(i, 2).Value <> "" Then
Destination.Cells(j, 1).Value = Source.Cells(i, 1).Value
Destination.Cells(j, 2).Value = Source.Cells(i, 2).Value
Destination.Cells(j, 3).Value = Source.Cells(i, 3).Value
Destination.Cells(j, 4).Value = Source.Cells(i, 4).Value
Destination.Cells(j, 5).Value = Source.Cells(i, 5).Value
Destination.Cells(j, 6).Value = Source.Cells(i, 6).Value
Destination.Cells(j, 7).Value = Source.Cells(i, 7).Value
Destination.Cells(j, 8).Value = Source.Cells(i, 8).Value
Destination.Cells(j, 9).Value = Source.Cells(i, 9).Value
j = j + 1
End If
Next i
Application.ScreenUpdating = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.Calculation = xlCalculationAutomatic
End Sub
[Edited to add a bit of clarity]

Answer 1

Replace your for loop with codes below.
Method 1: union all the range you would like to copy, and paste them at once.
Dim copyRange As Range
For i = 9 To 10000
If Source.Cells(i, 2).Value <> "" Then
If copyRange Is Nothing Then
Set copyRange = Source.Range(Source.Cells(i, 1), Source.Cells(i, 9))
Else
Set copyRange = Union(copyRange, Source.Range(Source.Cells(i, 1), Source.Cells(i, 9)))
End If
End If
Next i
copyRange.Copy Destination.Cells(2, 1)
Method 2(recommended): Use an autofilter for filtering the data.
Dim sourceRng As Range
Set sourceRng = Source.Range(Source.Cells(9, 1), Source.Cells(10000, 9))
sourceRng.AutoFilter Field:=2, Criteria1:="<>"
sourceRng.Copy Destination.Cells(2, 1)
Source.AutoFilterMode = False

Answer 2

Looping through worksheet rows is almost the slowest way to process data blocks. The only thing slower is looping through both rows and columns.
I'm not sure how many records you have but this processed 1500 rows of dummy data in ~0.14 seconds.
Option Explicit
Sub Macro4()
Dim wsSource As Worksheet, wsDestination As Worksheet
Dim i As Long, j As Long, k As Long, arr As Variant
On Error GoTo safe_exit
appTGGL bTGGL:=False
Set wsSource = Sheet1
Set wsDestination = Sheet4
'collect values from Sheet1 into array
With wsSource
arr = .Range(.Cells(9, "A"), .Cells(.Rows.Count, "B").End(xlUp).Offset(0, 7)).Value
End With
'find first blank in column B
For j = LBound(arr, 1) To UBound(arr, 1)
If arr(j, 2) = vbNullString Then Exit For
Next j
'collect A:I where B not blank
For i = j To UBound(arr, 1)
If arr(i, 2) <> vbNullString Then
For k = 1 To 9: arr(j, k) = arr(i, k): Next k
j = j + 1
End If
Next i
'clear remaining rows
For i = j To UBound(arr, 1)
For k = 1 To 9: arr(i, k) = vbNullString: Next k
Next i
'put values sans blanks into Sheet4
With wsDestination
.Cells(2, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End With
safe_exit:
appTGGL
End Sub
Sub appTGGL(Optional bTGGL As Boolean = True)
With Application
.EnableEvents = bTGGL
.ScreenUpdating = bTGGL
.DisplayAlerts = bTGGL
.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
End With
Debug.Print IIf(bTGGL, "end: ", "start: ") & Timer
End Sub