Hücreye kopyala

[ADER_34]

Merhaba arkadaşlar benim isteğim şöyle,çalışma kitabında "TELE" sayfasında "B" sütununda dolu satırları "İRSALİYE" sayfası ""A20" den itibaren "TELE" sayfası "F" sütunundaki dolu satırları "İRSALİYE" sayfası "G20" den itibaren kopyalamasın istiyorum kolay gelisn teşekkürler..
http://s6.dosya.tc/server11/5bvdoa/HUCREYE_AKTAR.xlsx.html

 

[askm]

Sub askm_Aktar()
Dim s1, s2 As Worksheet
Set s1 = Sheets("TEL")
Set s2 = Sheets("İRSALİYE")
Dim SonSat As Long
SonSat = s1.Range("B" & Rows.Count).End(xlUp).Row
a = 20
For i = 2 To SonSat
    s2.Cells(a, 1) = s1.Cells(i, 2)
    s2.Cells(a, 7) = s1.Cells(i, 6)
    a = a + 1
Next i
MsgBox "Aktarım tamamlandı...", vbInformation, "ASKM"
End Sub

 

[ADER_34]

Sayın askm çok teşekkür ederim kodlarınız sorunsuz,rica etsem irsaliye sayfasını masa üstüne o günün tarihi ile kaydedebilirimiyim,kodlara nasıl bir ilave yapmam gerek teşekkürler..

 

[askm]

Sub askm_Aktar()
Dim s1, s2 As Worksheet
Set s1 = Sheets("TEL")
Set s2 = Sheets("İRSALİYE")
Dim SonSat As Long
SonSat = s1.Range("B" & Rows.Count).End(xlUp).Row
a = 20
For i = 2 To SonSat
    s2.Cells(a, 1) = s1.Cells(i, 2)
    s2.Cells(a, 7) = s1.Cells(i, 6)
    a = a + 1
Next i
Call İrsaliye_Kaydet
MsgBox "Aktarım tamamlandı...", vbInformation, "ASKM"
End Sub
Sub İrsaliye_Kaydet()
yol = Environ("USERPROFILE") & "\Desktop\"  'CreateObject("WScript.Shell").SpecialFolders("Desktop")
ad = "İRSALİYE " & Format(Now, " dd.mm.yyyy_hh/mm")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("İRSALİYE").Copy

ActiveWorkbook.SaveAs Filename:=yol & ad & ".xls"
ActiveWorkbook.Close True
Application.ScreenUpdating = True
End Sub

 

[ADER_34]

Merhaba sayın askm kodlarınız sorunsuz çalışıyor çok teşekkür ederim kolay gelsin...