sayfalara dağıtım makro hata

[gmm]

arkadaşlar sayfalara dağıtım makrosu daha önceden yapılmıştı ama bu dosyada dağıtım yapılacak sütunu değiştirdiğinizde makro hata veriyor. yani dağıtımı d ye göre değilde f sütununa göre yaptığımızda hata ekranı çıkıyor yardım lütfen

 

[ersoyalan]

Merhaba dosyada problem yok. Ufak bir bölümü atlamışsınız. Ondan dolayı hata almışsınız.

İyi çalışmalar..

 

[gmm]

teşekkür ederim fakat atladığım yer neresiymiş söylermisiniz

 

[ersoyalan]

Range("L1").Value = Range("f1").Value kırmızı ile işaretli olan kısmı değiştirmemişsiniz.

 

[gmm]

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("VERİTABANI")


s1.Columns("b:b").Copy _
Destination:=Range("L1")
s1.Columns("L:L").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("J1"), Unique:=True
r = Cells(Rows.Count, "J").End(xlUp).Row


Range("L1").Value = Range("b1").Value

For Each c In Range("J2:J" & r)

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

If SAYFA(c.Value) Then
Sheets(c.Value).Cells.Clear ( hata burda gözüküyor b sütununu seçince )( debug yaptığımızda hata burasını veriyor)
ALAN.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("VERİ").Range("L1:L2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
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("L1:L2"), _
CopyToRange:=sY.Range("A1"), _
Unique:=False
End If
Next
s1.Select
s1.Columns("J:L").Delete
End Sub
Function SAYFA(SAYFAADI As String) As Boolean
On Error Resume Next
SAYFA = CBool(Len(Worksheets(SAYFAADI).Name) > 0)
End Function

 

[gmm]

sütunları değiştirince hata veriyor nedenini bulamadım

 

[gmm]

yardım lütfen