Aynı olanları sayfa2 ye sıralasın

[polis-53]

Merhaba arkadaşlar ekte gönderdiğim dosyada sayfa2 de A1 hücresine sayfa1 in M sutunundaki veriyi yazarsam yani kalecik yazarsam kalecik olanları sıralasın iyidere yazarsam iyidere olanları sıralasın tablo şeklinde sıralasın istiyorum eğer sayı azalır artar ise tabloyu sayıya göre artırsın azaltsın istiyorum. sayfa2 de bir yazdır butonuna eklenerek A1 hücresini yazdır butonuna tıkladığımda sayfa1 in M sutunundaki verileri otomatik getirip verilerin yazıcıdan çıktısınıda alabileyim yardımcı olursanız çok sevineceğim.

 

[Necdet]

Merhaba,

Sayfa2 A1 hücresine "Kalecik" yazdınız diyelim, Sayfa1 deki tüm kalecik olanlar Sayfa 2 ye mi gelecek?

 

[polis-53]

evet doğruden Necdet Yeşertener

 

[Necdet]

Merhaba,

Makrolu çözüm isterseniz eğer :

Aşağıdaki kodları Sayfa2 nin kod bölümüne kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Intersect(Target, [A1]) Is Nothing Then Exit Sub
 
    If Target.Value = "" Then Exit Sub
    Dim i As Long
 
    i = Cells(Rows.Count, "A").End(3).Row
    If i < 2 Then i = 2
 
    Range("A2:M" & i).Clear
 
    Aktar Target.Value
 
End Sub

Aşağıdaki kodları bir Modüle Kopyalayınız.

Sub Aktar(Deger As String)
 
    Dim i   As Long
    Dim s1  As Worksheet
    Dim s2  As Worksheet
 
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
 
    Application.ScreenUpdating = False
 
    s1.Select
    If s1.AutoFilterMode = True Then Selection.AutoFilter
    i = s1.Cells(Rows.Count, "A").End(3).Row
 
    s1.Range("$A$3:$M$" & i).AutoFilter Field:=13, Criteria1:=Deger
    s1.Range("A1").CurrentRegion.Offset(2, 0).Copy s2.Range("A2")
    Selection.AutoFilter
 
    s2.Select
 
End Sub

 

[polis-53]

merhaba Necdet Yeşertener çok teşekkür ederim işlerimin yoğunluğundan dolayı cevabım biraz geç oldu öncelikle özür dilerim dosyamla ilgili bir şeydaha isteyeceğim ekte gönderdiğim dosyada uyarlamaya çalıştım fakat başaramadım benim istediğim Tümünü yazdır butonuna bastığımda yazdırmasını istiyorum
iyi çalışmalar çok sağul ALLAH razı olsun.

 

[polis-53]

Necdet Yeşertener

sayın Necdet Yeşertener yardımlarınızı bekliyorum.

 

[Necdet]

Tümünü Yaz Butonu ile sayfa2 yi mi yazdırmak istiyorsunuz?

Amacınız o ise

Sub yaz()
    Sheets("Sayfa2").PrintOut
End Sub

 

[polis-53]

Sayın Necdet Yeşertener tümünü yaz butonunu tıkladığımda sırasıyla Sayfa2 nin A1 hücresine otomatik olarak kalecik gelecek kalecikteki verileri yazacak iyidere gelecek onun verilerini yazacak hopa gelecek onunkileri yazacak şekilde istiyorum

 

[Necdet]

Bir ara uygun olduğumda bakarım.

Keşke bu açıklamayı soruyu sorarken yapsaydınız.

 

[polis-53]

Necdet Yeşertener

ilgilendiğiniz için çok teşekkür ederim ben sormaya çalıştım herhalde sormayı beceremedim.kal sağlıcakla Necdet Yeşertener bey ALLAH dilediğini versin

 

[Necdet]

Merhaba,

Aşağıdaki kodları deneyiniz.
 
Sub Suz_ve_Yaz()
    Dim i       As Long
    Dim j       As Long
    Dim Dizi()  As String
    Dim s2      As Worksheet
    
    Set s2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
    
    If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter
    i = Cells(Rows.Count, "A").End(3).Row
    Range("M3:M" & i).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "N1"), Unique:=True
        
    j = Cells(Rows.Count, "N").End(3).Row
    ReDim Dizi(j - 2)
    
    For i = 2 To j
        Dizi(i - 2) = Cells(i, "N")
    Next i
    
    Columns("N").Delete
    
    i = Cells(Rows.Count, "A").End(3).Row
    
    For j = 0 To UBound(Dizi)
        Range("$A$3:$M$" & i).AutoFilter Field:=13, Criteria1:=Dizi(j)
        s2.Cells.ClearContents
        Range("A1").CurrentRegion.Offset(2, 0).Copy s2.Range("A2")
        s2.Range("A1") = Dizi(j)
'        s2.PrintPreview
        s2.PrintOut
    Next j
    
    Selection.AutoFilter
    
End Sub

 

[polis-53]

Çoooooooooook teşekkür ederim mükemmel oldu ne muranın varsa ALLAH versin.

 

[Necdet]

Çoooooooooook teşekkür ederim mükemmel oldu ne muranın varsa ALLAH versin.

Aaaaminnnnn