Sütunlara Göre Veri Ayırmak

[sokrates11]

Ekteki dosyadaki gibi bir Veriler sayfam var. Burada 3 farklı (daha fazla da olabilir) işlem var. Butona bastığımda bu 3 işleme göre verileri sayfalara ayırmak istiyorum.

Bir örnek buldum ancak istediğime uyarlayamadım. Linkini verdiğim örnekte Firmaya göre ayrım yapılmış. Tek sütun var. Ben 3 sütundaki değişkenlere göre sayfalara ayırmak istiyorum.
şimdiden teşekkürler......

"""""örnek linki:Macro ile yapılmış durumu ektedir.
Eklenmiş Dosyalar
SAYFALARA DAIT(Macro).zip""""""

 

[bedri41]

Formül ile yapılmış bir çözüm isterseniz ekteki dosyanızı inceleyiniz.

 

[sokrates11]

Teşekkür ederim Bedri41. Makro olsa daha iyi olacak.

 

[chngrcn]

Eki inceleyeniz.. saygılar..

Sub Düğme1_Tıklat() ' CODED BY CİHANGİR...
On Error Resume Next

Set s = Sheets("Veriler")
Set s1 = Sheets("Dosya")
Set s2 = Sheets("İade")
Set s3 = Sheets("Servis")

s1.Range("A2:DM65536").ClearContents
s2.Range("A2:DM65536").ClearContents
s3.Range("A2:DM65536").ClearContents

sat1 = s1.[A65536].End(3).Row + 1
sat2 = s2.[A65536].End(3).Row + 1
sat3 = s3.[A65536].End(3).Row + 1

Application.ScreenUpdating = False

s1.Select
For i = 2 To s.[C65536].End(3).Row

If s.Cells(i, 3).Value <> "" Then

s1.Cells(sat1, 1).Value = s.Cells(i, 1).Value
s1.Cells(sat1, 2).Value = s.Cells(i, 2).Value
s1.Cells(sat1, 3).Value = s.Cells(i, 3).Value
s1.Cells(sat1, 4).Value = s.Cells(i, 4).Value

      sat1 = sat1 + 1
        End If
          Next i


s2.Select

For y = 2 To s.[E65536].End(3).Row

If s.Cells(y, 5).Value <> "" Then

s2.Cells(sat2, 1).Value = s.Cells(y, 1).Value
s2.Cells(sat2, 2).Value = s.Cells(y, 2).Value
s2.Cells(sat2, 3).Value = s.Cells(y, 5).Value
s2.Cells(sat2, 4).Value = s.Cells(y, 6).Value

    sat2 = sat2 + 1
      End If
        Next y


s3.Select

For z = 2 To s.[G65536].End(3).Row

If s.Cells(z, 7).Value <> "" Then

s3.Cells(sat3, 1).Value = s.Cells(z, 1).Value
s3.Cells(sat3, 2).Value = s.Cells(z, 2).Value
s3.Cells(sat3, 3).Value = s.Cells(z, 7).Value
s3.Cells(sat3, 4).Value = s.Cells(z, 8).Value
  
  sat3 = sat3 + 1
     End If
        Next z


s.Select

Application.ScreenUpdating = True
MsgBox " Aktarım tamamlandı.. ", , ""

End Sub

 

[sokrates11]

Teşekkürler...