Kaynak Sayfadan Diğer Sayfaya Özet İcmal Getirme

[anilman]

Merhaba, ekteki dosyada 'İcmal' sayfasında yer alan tablolarımı (değerleri 0 olanları eleyip) kod yardımıyla 'Son' isimli sayfama çekmek istiyorum böyle bir şey yapmam mümkün mü? Not: Kaynak sayfadaki ürün çeşitliliği satır sayısı olarak artıp azalabilir. Şimdiden teşekkürler.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu deneyiniz.

Option Explicit

Sub Aktar()
    Dim S1 As Worksheet, S2 As Worksheet
   
    Application.ScreenUpdating = False
   
    Set S1 = Sheets("İCMAL")
    Set S2 = Sheets("ÖZET")
   
    S2.Range("B5:O" & S2.Rows.Count).Clear
   
    If S1.AutoFilterMode Then S1.AutoFilterMode = False
    S1.Range("B4:C" & S1.Rows.Count).AutoFilter 2, "<>0"
    If S1.Cells(S1.Rows.Count, "C").End(3).Row > 4 Then
        S1.Range("B5:C" & S1.Cells(S1.Rows.Count, "C").End(3).Row).Copy S2.Range("B5")
    End If
    If S1.AutoFilterMode Then S1.AutoFilterMode = False
    S1.Range("F4:G" & S1.Rows.Count).AutoFilter 2, "<>0"
    If S1.Cells(S1.Rows.Count, "G").End(3).Row > 4 Then
        S1.Range("F5:G" & S1.Cells(S1.Rows.Count, "G").End(3).Row).Copy S2.Range("F5")
    End If
    If S1.AutoFilterMode Then S1.AutoFilterMode = False
    S1.Range("J4:K" & S1.Rows.Count).AutoFilter 2, "<>0"
    If S1.Cells(S1.Rows.Count, "K").End(3).Row > 4 Then
        S1.Range("J5:K" & S1.Cells(S1.Rows.Count, "K").End(3).Row).Copy S2.Range("J5")
    End If
    If S1.AutoFilterMode Then S1.AutoFilterMode = False
    S1.Range("N4:O" & S1.Rows.Count).AutoFilter 2, "<>0"
    If S1.Cells(S1.Rows.Count, "O").End(3).Row > 4 Then
        S1.Range("N5:O" & S1.Cells(S1.Rows.Count, "O").End(3).Row).Copy S2.Range("N5")
    End If
    If S1.AutoFilterMode Then S1.AutoFilterMode = False

    S2.Select

    Set S1 = Nothing
    Set S2 = Nothing
   
    Application.ScreenUpdating = True
   
    MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
End Sub

 

[anilman]

Çok teşekkürler hocam emeğinize sağlık