istenilen verilerin sayfa2 ve sayfa3 e aktarılması

[karakayalı]

sis bayramlar...dosya ektedir...kolay gelsin....

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub aktar()
Dim i As Long, sat2 As Long, sat3 As Long, dogum As Variant
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
sat2 = 1: sat3 = 1
Application.ScreenUpdating = False
s2.Range("A1:A65536").ClearContents
s3.Range("A1:A65536").ClearContents
For i = 1 To Cells(65536, "A").End(xlUp).Row
    dogum = Right(Cells(i, "A").Value, 4)
    If IsNumeric(dogum) Then
        If dogum >= 1980 And dogum <= 1990 Then
            s3.Cells(sat3, "A").Value = Cells(i, "A").Value
            sat3 = sat3 + 1
        End If
        If dogum >= 1970 And dogum < 1980 Then
            s2.Cells(sat2, "A").Value = Cells(i, "A").Value
            sat2 = sat2 + 1
        End If
    End If
Next i
Application.ScreenUpdating = True
Set s2 = Nothing
Set s3 = Nothing
MsgBox "Aktarma Tamamlandı..!!"
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub aktar()
For a = 1 To [a65536].End(3).Row
deg = Right(Cells(a, "a"), 4)
If deg <= 1980 Then
c = c + 1
Sheets("sayfa2").Cells(c, "a") = Cells(a, "a")
Else
d = d + 1
Sheets("sayfa3").Cells(d, "a") = Cells(a, "a")
End If
Next
End Sub

 

[karakayalı]

gecenin bu vaktinde ilgi ve alakanıza teşekkürler...elinize sağlık...

 

[cebelitarık]

Selam arkadaşlar
Tüm forum üyelerin geçmiş bayramı mübarek olsun
Yukardaki makro benim işime de yarayacak.
Yukardaki excel tablosunda isim ve doğum tarihleri A sütununda değilde, isimler A sütununda doğum tarihleri de B sutunda ve C,D sütunlarında da ilgili kişi için bilgiler var ise mokro da nasıl bir değişiklik yapılabilir. Ayrıca sayfa 2 ve sayfa 3 e bilgiler 20 . satırdan itibaren yazılması gerekiyor.
ilgilenecek arkadaşlara teşekkür ederim.

 

[karakayalı]

sayın orion2 yaptığınız makroda yıl yazının sonunda ise çalışıyor ancak ortada veya yaznıın her hangi bir bölümünde yer alıyorsa çalışmıyor...örneğin
"ali ak kkk sokak no:10 01.01.1982" ise çalışıyor...
"ali ak kkk sokak no:10 01.01.1982 ankara" bu durumda ise çalışmıyor...yardımlarınız için şimdiden teşekkürler..

 

[cebelitarık]

Herkese merhabalar
5. mesajıma cevap bekliyorum arkadaşlar

 

[Orion1]

sayın orion2 yaptığınız makroda yıl yazının sonunda ise çalışıyor ancak ortada veya yaznıın her hangi bir bölümünde yer alıyorsa çalışmıyor...örneğin
"ali ak kkk sokak no:10 01.01.1982" ise çalışıyor...
"ali ak kkk sokak no:10 01.01.1982 ankara" bu durumda ise çalışmıyor...yardımlarınız için şimdiden teşekkürler..

Zaten benim yazdığım kodlar tarih sondaysa çalışıyor.
Tarihin yazının herhangi bir yerinde olması durumunda nasıl olacağı konusunda ise bir bilgim yok.

 

[cebelitarık]

ilgilenecek bir arkadaş yokmu sayfanın başında heyecanla bekliyorum.
5. mesaja cevap verecek bir arkadaş lütfen.

 

[Orion1]

ilgilenecek bir arkadaş yokmu sayfanın başında heyecanla bekliyorum.
5. mesaja cevap verecek bir arkadaş lütfen.

Yeni bir topic açıp örnek dosya yollarsanız dağa çabuk cevap alabilirsiniz sanırım.

 

[Levent Menteşoğlu]

sayın orion2 yaptığınız makroda yıl yazının sonunda ise çalışıyor ancak ortada veya yaznıın her hangi bir bölümünde yer alıyorsa çalışmıyor...örneğin
"ali ak kkk sokak no:10 01.01.1982" ise çalışıyor...
"ali ak kkk sokak no:10 01.01.1982 ankara" bu durumda ise çalışmıyor...yardımlarınız için şimdiden teşekkürler..

Aşağıdaki kodu deneyin.

Sub aktar()
For a = 1 To [a65536].End(3).Row
deg = Mid(Cells(a, "a"), InStr(1, Cells(a, "a"), 19), 4)
If deg <= 1980 Then
c = c + 1
Sheets("sayfa2").Cells(c, "a") = Cells(a, "a")
Else
d = d + 1
Sheets("sayfa3").Cells(d, "a") = Cells(a, "a")
End If
10 Next
End Sub

 

[karakayalı]

syn leventm makro düzgün çalışmadı...birde bu bilgiler arasınada 1950-1940 gibi bilgiler var...ben sadece 1970-1980 ve 1980-1990 doğumluları ayrı sayfada görmek istiyorum...

 

[karakayalı]

Sub aktar()
Dim i As Long, sat2 As Long, sat3 As Long, dogum As Variant
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
sat2 = 1: sat3 = 1
Application.ScreenUpdating = False
s2.Range("A1:A65536").ClearContents
s3.Range("A1:A65536").ClearContents
For i = 1 To Cells(65536, "A").End(xlUp).Row
dogum = Right(Cells(i, "A").Value, 4)
If IsNumeric(dogum) Then
If dogum >= 1980 And dogum <= 1990 Then
s3.Cells(sat3, "A").Value = Cells(i, "A").Value
sat3 = sat3 + 1
End If
If dogum >= 1970 And dogum < 1980 Then
s2.Cells(sat2, "A").Value = Cells(i, "A").Value
sat2 = sat2 + 1
End If
End If
Next i
Application.ScreenUpdating = True
Set s2 = Nothing
Set s3 = Nothing
MsgBox "Aktarma Tamamland&#305;..!!"
End Sub

daha &#246;nceden orion2 taraf&#305;ndan g&#246;nderilen bu kodun de&#287;i&#351;ik &#351;ekilde denedim ancak ba&#351;aramad&#305;m...istedi&#287;im do&#287;um tarihinin c&#252;mlenin her hangi bir yerinde ge&#231;mesi halindede sonu&#231;lar&#305;n&#305; sayfa2 ve sayfa3 e atmas&#305;...ilgilenen arkada&#351;lara &#351;imdiden te&#351;ekk&#252;rler...