sadece dolu satırları kopyala

[muhsar]

aşağıdaki makro kaydet yöntemi ile oluşturduğum kodlar veri giriş kitabında bulunan randevular sayfasında ilk dolu satırları seçip kopyalayıp randevu takip isimli çalışma kitabına dolu satırların sonuna ekleyerek yapıştır yapıyor,buraya kadar tamam sorunum;giriş kitabında bulunan randevular sayfasında eğer veriler yoksa tüm sayfayı kopyalıyor,sadece dosya numarası yazan sütun dolu olanları kopyalaması için kodu nasıl değiştirmem gerekir


Sub randevuaktar()
'
' randevuaktar Makro
'

'
Application.ScreenUpdating = False
Range("A2:J2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Open Filename:="F:\EVDE SAĞLIK\RANDEVU TAKİP.xlsx"
ActiveWindow.ScrollRow = 1
ActiveWindow.SmallScroll Down:=-15
Range("A" & Cells(Rows.Count, 2).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
Range("A5").Select
MsgBox "Aktarım Tamamlandı", vbInformation + vbMsgBoxRtlReading, "***************"
Application.ScreenUpdating = True
End Sub