farklı sayfalar arasında veri süzme

Katılım
17 Ekim 2017
Mesajlar
110
Excel Vers. ve Dili
Microsoft Office 2013 Standard
Altın Üyelik Bitiş Tarihi
28.04.2024
Merhaba arkadaşlar,
Ekte örnek çalışmasını yaptığım tabloda sayfa1 içerisindeki verileri süzerek sayfa2 de gerekli alanlara yazmak için formül yada makro çalışması nasıl olmalı,
Yapmak istediklerimi çalışmanın içerisinde belirttim.
Yardımcı olmanızı rica ediyorum. Teşekküler.
 

Ekli dosyalar

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,520
Excel Vers. ve Dili
Office 365 Türkçe
Merhaba deneyiniz.
Kod:
Sub Emr()
Dim Son As Long, i As Long
Son = 2
For i = 2 To Sheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row
    If Sheets("Sayfa1").Cells(i, "B") = "FIRSAT" Then
        Sheets("Sayfa2").Cells(Son, "A") = Sheets("Sayfa1").Cells(i, "A")
        Sheets("Sayfa2").Cells(Son, "B") = Sheets("Sayfa1").Cells(i, "C")
        Sheets("Sayfa2").Cells(Son, "C") = Sheets("Sayfa1").Cells(i, "D")
        Son = Son + 1
    End If
Next
End Sub
 

Ekli dosyalar

Katılım
17 Ekim 2017
Mesajlar
110
Excel Vers. ve Dili
Microsoft Office 2013 Standard
Altın Üyelik Bitiş Tarihi
28.04.2024
Emr123 teşekkür ederim öncelikle. Rica etsem satış miktarı "0" olanları sayfa 2'ye getirmesin. Örneğin X satıcısı fırsat ürünlerinde satış miktarı yok ise göstermesin. Sadece satışı olan ürünleri listelesin. Bunu yapabilir miyiz?
 

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,520
Excel Vers. ve Dili
Office 365 Türkçe
Rica ederim ne demek, kodları aşağıdaki gibi revize ettim ve çalıştırman içinde bir buton koydum iyi çalışmalar.
Kod:
Sub Emr()
Dim Son As Long, i As Long
Son = 2
Sheets("Sayfa2").Range("A2:C10000").ClearContents
For i = 2 To Sheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row
    If Sheets("Sayfa1").Cells(i, "B") = "FIRSAT" And Sheets("Sayfa1").Cells(i, "D") > 0 Then
        Sheets("Sayfa2").Cells(Son, "A") = Sheets("Sayfa1").Cells(i, "A")
        Sheets("Sayfa2").Cells(Son, "B") = Sheets("Sayfa1").Cells(i, "C")
        Sheets("Sayfa2").Cells(Son, "C") = Sheets("Sayfa1").Cells(i, "D")
        Son = Son + 1
    End If
Next
End Sub
 

Ekli dosyalar

Üst