- Katılım
- 31 Ocak 2006
- Mesajlar
- 3
merhabalar.
excel de bir listeyi sayfalara ayırmak için aşağıdaki makro tanımlı.
ancak satır sayısı 100 ile sınırlı. yani 100 üncü satırdan sonrası için makro çalışmıyor ve sayfa oluşturmuyor.
nasıl tüm listeyi aktif hale getirebilirim?
saygılar
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
excel de bir listeyi sayfalara ayırmak için aşağıdaki makro tanımlı.
ancak satır sayısı 100 ile sınırlı. yani 100 üncü satırdan sonrası için makro çalışmıyor ve sayfa oluşturmuyor.
nasıl tüm listeyi aktif hale getirebilirim?
saygılar
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