- Katılım
- 10 Mayıs 2012
- Mesajlar
- 7
- Excel Vers. ve Dili
- OFİS 2007
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("d:d").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("d1").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
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
arkadaslar yukardaki makroyu 2003 de calıştırıyordum ama 2007 de debug hatası verıyor sebebi nedir acaba??
makronun ozelliği sayfanın d sutununda yazanlara ayrı sayfa acıp o sutundaki kriterlere gore sayfalara dagıtması...
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("d:d").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("d1").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
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
arkadaslar yukardaki makroyu 2003 de calıştırıyordum ama 2007 de debug hatası verıyor sebebi nedir acaba??
makronun ozelliği sayfanın d sutununda yazanlara ayrı sayfa acıp o sutundaki kriterlere gore sayfalara dagıtması...
