Hücredeki verinin aktarılması yerine tüm hücrenin kopyalanıp yapıştırılması

[Erdinç FIRTINA]

Değerli üyeler,
Forumdan yararlanarak (aynen alınarak) hazırlanan kodlar ile kapalı dosyalardaki belirtilen adreslerdeki veriler, "TAMAMI" adlı dosyada belirlenen bir hücreden başlayarak alt alta aktarılıyor.
Örneğin; Sayfa 1 lerdeki tüm "A4" hürelerindeki veriler alt alta olacak şekilde aktarılıyor. Değişiklik yapmak istediğim, sadece dolu olan hücrelerdeki verilerin aktarılması değil, boş olan hücrelerin de aktarılması.
Yani,
Her dosyanın her "Sayfa1" "A4" hücrelerindeki verilerin kopyalanıp aktarılması yerine,
Her dosyanın her "Sayfa1" "A4" hücresinin olduğu gibi kopyalanıp aktarılmasını istiyorum. (Hücre içindeki veri yerine hücre boş bile olsa aktarılması)
Bunun için aşağıdaki satırda nasıl bir değişiklik yapmam gerekiyor?

Yardımlarınız için şimdiden çok teşekkürler!!!

Range("a4").Copy S1.Cells(65536, 1).End(3).Offset(1)


Sub VERİLERİ_GÜNCELLE()
Application.ScreenUpdating = False
Dosya_Yolu = "C:\HEPSİ\"
Set S1 = Workbooks("TAMAMI.xls").Sheets("32 GELİRLER")
S1.Select
[A2:AA65536].ClearContents
Set Klasör = CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
For Each Dosya In Klasör
If InStr(Dosya.Name, ".xls") > 0 Then
If Dosya.Name <> "TAMAMI.xls" Then
Workbooks.Open Filename:=Dosya
Sheets("Sayfa1").Select
Range("a4").Copy S1.Cells(65536, 1).End(3).Offset(1)
Range("B4").Copy S1.Cells(65536, 2).End(3).Offset(1)
Range("A5").Copy S1.Cells(65536, 3).End(3).Offset(1)
Range("B5").Copy S1.Cells(65536, 4).End(3).Offset(1)

ActiveWorkbook.Close True
End If
End If
Next

Application.ScreenUpdating = True
MsgBox "Veriler aktarılmıştır.", vbInformation
End Sub