veriler süzüldükten sonra sayfaya aktarmada sorun

[kaan43274]

topladıgım örneklerle kendime yeni bir çalışma sayfası olusturdum bu sayfada dagıt diye bir makro atadım istedigim kolonlarda sayfa olusturuyor fakat içerik olarak verdigim yer tam geçmiyor sadece a firmasının verileri geçiyor digerfirmaların verileri geçmiyor

kod şu
Option Explicit

Option Explicit

Sub DAGIT()
Dim s1 As Worksheet
Dim sY As Worksheet
Dim ALAN As Range
Dim r As Integer
Dim c As Range
Set s1 = Sheets("VERİ")
Set ALAN = Range("VERITABANI")


s1.Columns("I:I").Copy _
Destination:=Range("P1")
s1.Columns("P").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("N1"), Unique:=True
r = Cells(Rows.Count, "N").End(xlUp).Row


Range("P1").Value = Range("I1").Value

For Each c In Range("N2:N" & r)

s1.Range("N2").Value = c.Value

If SAYFA(c.Value) Then
Sheets(c.Value).Cells.Clear
ALAN.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("VERİ").Range("P12"), _
CopyToRange:=Sheets(c.Value).Range("A2"), _
Unique:=False

Else

Set sY = Sheets.Add
sY.Move After:=Worksheets(Worksheets.Count)
sY.Name = c.Value
ALAN.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("VERİ").Range("P12"), _
CopyToRange:=sY.Range("A2"), _
Unique:=False
End If
sY.Range("f1") = WorksheetFunction.Sum(Range("F3:F2000"))
sY.Range("g1") = WorksheetFunction.Sum(Range("g3:g2000"))
sY.Range("h1") = WorksheetFunction.Sum(Range("h3:h2000"))
sY.Cells.Columns.AutoFit



Next
s1.Select
s1.Columns("P:N").Delete
End Sub
Function SAYFA(SAYFAADI As String) As Boolean
On Error Resume Next
SAYFA = CBool(Len(Worksheets(SAYFAADI).Name) > 0)
End Function

 

[kaan43274]

bu konu hakkında yardımcı olabilecek ustalar yokmu???