Hamdi Bey, geç cevap için kusura bakmayın, işler biraz yoğun...
Aşağıdaki kodu dener misiniz?
Sub Excelce_Biten_Kayit_Aktar()
Dim excelce As Long, say As Long, dolusay As Long
Dim biten As Workbook
Set biten = Workbooks.Open(ThisWorkbook.Path & Application.PathSeparator & "Biten İşler" & Application.PathSeparator & "Biten İşler.xls")
For excelce = ThisWorkbook.Worksheets("Sayfa1").Range("A65530").End(3).Row To 2 Step -1
If ThisWorkbook.Worksheets("Sayfa1").Range("G" & excelce) <> Empty Then
say = say + 1
dolusay = biten.Worksheets("Sayfa1").Range("A65530").End(3).Row + 1
ThisWorkbook.Worksheets("Sayfa1").Range("G" & excelce).EntireRow.Cut Destination:=biten.Worksheets("Sayfa1").Range("A" & dolusay)
ThisWorkbook.Worksheets("Sayfa1").Range("G" & excelce).EntireRow.Delete
End If
Next excelce
If say > 0 Then
MsgBox say & " adet kayıt aktarıldı.", vbInformation, "İşlem Tamam"
Else
MsgBox "Aktarılacak kayıt bulunamadı!", vbExclamation, "İşlem Tamam"
End If
biten.Close True
End Sub