Bedingung beim Kopieren

Sub Offen_Liste()
Dim objWS1 As Worksheet, objWS2 As Worksheet
Dim varSheets As Variant
Dim rng As Range
Dim lngLast As Long, lngRow As Long
Dim intIndex As Integer
varSheets = Array("Daten") ' Namen der Quelltabellen - Namen anpassen!
Set objWS1 = Sheets("Alle") ' Zieltabelle - Name anpassen!
objWS1.Range("A2:IV65536").Clear ' Ab Zeile 2 - erste Zeile Überschriften!
For intIndex = 0 To UBound(varSheets)
Set objWS2 = Sheets(varSheets(intIndex))
With objWS2
lngLast = .Cells(Rows.Count, 1).End(xlUp).Row
For lngRow = 2 To lngLast ' Ab Zeile 2 - erste Zeile Überschriften!
If Application.CountA(.Rows(lngRow)) > 0 Then
If rng Is Nothing Then
Set rng = .Rows(lngRow)
Else
Set rng = Union(rng, .Rows(lngRow))
End If
End If
Next
If Not rng Is Nothing Then
rng.Copy objWS1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Set rng = Nothing
End If
End With
Set objWS2 = Nothing
Next
Set objWS1 = Nothing
End Sub