Belirli bir veri aralığını başka bir sheet'te gösterme! Acil yardım !!!

[arnavut]

Merhaba arkadaşlar,

Sheet1'deki listedeki verilerden sadece istediğim satırları sheet2'ye kopyalanmasını istiyorum ama komutlarla bunu beceremedim. Yani yapmak istediğim tam olarak şu; Sheet1'deki verilerden sadece ayın 20'sine ait olanları Sheet2'ye yazılmasını istiyorum.
Bunu hangi komutu kullanarak yapabilirim?

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

 

[Orion1]

Dosyanız ekte.

Sub aktar()
Dim k, tarih As Date, i As Long, adr1 As Range, adr2 As Range, sat As Long
Sheets("Sheet2").Select
Range("A2:L65536").ClearContents
Application.ScreenUpdating = False
basla:
k = InputBox("Listelenecek tarihi giriniz....:", "LİSTELEME", Format(DateSerial(Year(Date), Month(Date), 20), "dd.mm.yyyy"))
If k = "" Then Exit Sub
If Not IsDate(k) Then
    MsgBox "Bir tarih giriniz..!!", vbCritical, "UYARI"
    GoTo basla
End If
With Sheets("Sheet1")
On Error Resume Next
sat = 2
For i = 2 To .Cells(65536, "A").End(xlUp).Row
    tarih = DateSerial(.Cells(i, "C").Value, .Cells(i, "B").Value, .Cells(i, "A").Value)
    If tarih = k Then
        Set adr1 = .Range(.Cells(i, "A"), .Cells(i, "L"))
        Set adr2 = Range(Cells(sat, "A"), Cells(sat, "L"))
        adr2.Value = adr1.Value
        sat = sat + 1
    End If
Next i
End With
Set adr1 = Nothing
Set adr2 = Nothing
Application.ScreenUpdating = True
MsgBox "[ " & k & " ] Tarihindeki satırlar Sheet2'ye aktarıldı..!!", vbOKOnly + vbInformation, "AKTARMA"

End Sub

 

[arnavut]

Sayın Evren Gizlen,
İlginiz ve yardımınız için çok teşekkür ederim.
Ben excel'in komutlarıyla çözülür sanıyordum ve dünden beri denemediğim yol kalmadı.
Sandığım kadar basit değilmiş anlaşılan.
iyi çalışmalar.

 

[ersoyalan]

Merhaba,

Alternatif olması için.

E.ALAN

 

[arnavut]

Tekrar merhaba,
sayın, Evren Gizlen, bu olayı sorgusuz nasıl yapabiliriz?
yani bana istediğim tarihi girmemi sormasın, mesela 2.12.2008 tarihli verileri getirsin sadece.
Aslında sheet1'de veriler otomatik olarak sıralanıyor veri kaynağı web'den bir site.
Benim istediğim sheet1'de değişiklik olduğunda hemen otomatik olarak sheet2'ye yansıması, ama belirtilen tarihin sadece (2.12.2008 mesela) . Verdiğiniz kodu bu şekilde uyarlayamadım bir türlü.
yardımcı olursanız çok memnun olurum.
asıl dosyayı ekte gönderiyorum.

 

[arnavut]

arkadaşlar yanıtınızı bekliyorum dört gözle

 

[arnavut]

acil olarak yardımınıza ihtiyacım var arkadaşlar

 

[arnavut]

cevabınızı bekliyorum excel hocalarım,
acil yardımınıza ihtiyacım var bu konuda

 

[Orion1]

Dosyanız ekte.

Sub aktar()
Dim k, tarih As Date, i As Long, adr1 As Range, adr2 As Range, sat As Long
Sheets("Sheet2").Select
Range("A2:L65536").ClearContents
Application.ScreenUpdating = False
basla:
k = DateSerial(2008, 12, 2)
If k = "" Then Exit Sub
If Not IsDate(k) Then
    MsgBox "Bir tarih giriniz..!!", vbCritical, "UYARI"
    GoTo basla
End If
With Sheets("Sheet1")
On Error Resume Next
sat = 2
For i = 2 To .Cells(65536, "A").End(xlUp).Row
    tarih = DateSerial(.Cells(i, "M").Value, .Cells(i, "L").Value, .Cells(i, "K").Value)
    If tarih = k Then
        Set adr1 = .Range(.Cells(i, "K"), .Cells(i, "V"))
        Set adr2 = Range(Cells(sat, "A"), Cells(sat, "L"))
        adr2.Value = adr1.Value
        sat = sat + 1
    End If
Next i
End With
Set adr1 = Nothing
Set adr2 = Nothing
Application.ScreenUpdating = True
MsgBox "[ " & k & " ] Tarihindeki satırlar Sheet2'ye aktarıldı..!!", vbOKOnly + vbInformation, "AKTARMA"

End Sub

 

[arnavut]

yardımlarınız için çok teşekkür ederim sayın Evren Gizlen
çok uğraştırdım sizi, kusura bakmayın. sağolun

 

[Orion1]

yardımlarınız için çok teşekkür ederim sayın Evren Gizlen
çok uğraştırdım sizi, kusura bakmayın. sağolun

Rica ederim.
İyi çalışmalar.

 

[ojibu]

aylara göre olabilir mi?

sayın evren, bu kodda tarihi ayrı ayrı değilde 20.12.2008 şekilde kaydedillmiş bir veri sayfasından aylara göre aktarma olabilirmi? örnek ekte

 

[Orion1]

sayın evren, bu kodda tarihi ayrı ayrı değilde 20.12.2008 şekilde kaydedillmiş bir veri sayfasından aylara göre aktarma olabilirmi? örnek ekte

2008 yılının aralık ayını sayfa2de listeler.
Dosyanız ekte.

Sub aktar()
Dim k, tarih As Date, i As Long, adr1 As Range, adr2 As Range, sat As Long
Sheets("Sheet2").Select
Range("A2:J65536").ClearContents
Application.ScreenUpdating = False
With Sheets("Sheet1")
On Error Resume Next
sat = 2
For i = 2 To .Cells(65536, "A").End(xlUp).Row
    If Month(.Cells(i, "A")) = 12 And Year(.Cells(i, "A")) = 2008 Then
        Set adr1 = .Range(.Cells(i, "A"), .Cells(i, "J"))
        Set adr2 = Range(Cells(sat, "A"), Cells(sat, "J"))
        adr2.Value = adr1.Value
        sat = sat + 1
    End If
Next i
End With
Set adr1 = Nothing
Set adr2 = Nothing
Application.ScreenUpdating = True
MsgBox "[ " & k & " ] Tarihindeki satırlar Sheet2'ye aktarıldı..!!", vbOKOnly + vbInformation, "AKTARMA"

End Sub

 

[ojibu]

sayın evren yine sizi yorduk. ancak tarih yazılmamışsa yada tarih yerine YOK yazıyoruz bazen ancak o satırıda taşıyor buna bir el atın
teşekkürler

 

[Orion1]

Aşağıdaki kodu kullanınız.

Sub aktar()
Dim k, tarih As Date, i As Long, adr1 As Range, adr2 As Range, sat As Long
Sheets("Sheet2").Select
Range("A2:J65536").ClearContents
Application.ScreenUpdating = False
With Sheets("Sheet1")
On Error Resume Next
sat = 2
For i = 2 To .Cells(65536, "A").End(xlUp).Row
    If IsDate(.Cells(i, "A").Value) Then
    If Month(.Cells(i, "A").Value) = 12 And Year(.Cells(i, "A").Value) = 2008 Then
        Set adr1 = .Range(.Cells(i, "A"), .Cells(i, "J"))
        Set adr2 = Range(Cells(sat, "A"), Cells(sat, "J"))
        adr2.Value = adr1.Value
        sat = sat + 1
    End If
    End If
Next i
End With
Set adr1 = Nothing
Set adr2 = Nothing
Application.ScreenUpdating = True
MsgBox "[ Aralık - 2008 ] Tarihindeki satırlar Sheet2'ye aktarıldı..!!", vbOKOnly + vbInformation, "AKTARMA"

End Sub