- Katılım
- 28 Aralık 2011
- Mesajlar
- 17
- Excel Vers. ve Dili
- xp
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
günaydın arkadaşlar, inşallah bu programı bugün yetiştiririm.
yardımlarınız için şimdiden teşekkür ederim.
Option Explicit
Sub tarih_bazlı_aktar_1967()
'Konu : Yazılı tarihe Göre Aktar
'Mail : m.batu.1967@gmail.com
'Msn : m.batu.1967@hotmail.com.tr
'Skype : m.batu.1967
'Coder By : asi_kral_1967
Dim S1 As Worksheet, S2 As Worksheet
Dim SÜT As Variant, SAB As Variant
Set S1 = Sheets("GÜNLÜK LİSTE")
Set S2 = Sheets("AYLIK LİSTE")
Application.ScreenUpdating = False
S2.Select
SAB = ActiveCell.Address
S1.Select
With WorksheetFunction
SÜT = S2.Cells(4, .Match(S1.Range("C1"), S2.Rows("4:4"), 0)).Address
SÜT = Replace(Replace(SÜT, "$", ""), 4, "")
S1.Range("E5:E154").Copy
S2.Range(SÜT & 5).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
S2.Select
S2.Range(SAB).Select
S1.Select
End With
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub
asi_kral_1967 çok ama çok teşekkür ederim. süper çalışıyor.