• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Hücreye kopyala

Katılım
2 Haziran 2015
Mesajlar
349
Excel Vers. ve Dili
2010
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
 
Kod:
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
 
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..
 
Kod:
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
 
Merhaba sayın askm kodlarınız sorunsuz çalışıyor çok teşekkür ederim kolay gelsin...
 
Geri
Üst