AccessTr.neT

Ne demek Kolay gele
[/quote]
Ne demek şimdi bu ?
[/quote]

Şuan nöbetciyim fazla ilgilenemiyorum kusura bakmayın yazmışsınız

Bende kusur ne demek, canınız sağ olsun, anlamında kolay gele demek istedim...

Özür dilerim ben yanlış anlamışım.

Merhaba birde bu kodu denermisiniz.İki tane modul ekleyelim ve bu modüllere ayrı ayrı sayfa ekleyeceğiz birde sayafa isimlerini sen kendine göre değiştirirsin.
Anasayfaya aşağıdaki kodu ekleyelim.
Mödül 1 yazılacak olan kod
Modül 2 yazılacak kod
[/code]
Option Explicit

Sub SAYFALARI_ALFABETİK_SIRALA()
Dim X As Integer, Y As Integer, Say As Integer
Application.ScreenUpdating = False
Sheets(1).Select
Say = Sheets.Count
If Say < 2 Then Exit Sub
Sheets.Add , After:=Sheets("ANA SAYFA")
ActiveSheet.Name = "Liste"
For X = 2 To Sheets.Count
Sheets("Liste").Cells(X - 1, 1) = Sheets(X).Name
If Sheets(X).Visible = False Then
Sheets(X).Visible = True
Sheets("Liste").Cells(X - 1, 2) = "Gizli"
End If
Next
[A:B].Sort Key1:=Range("A2"), Order1:=xlAscending
[A1].Select
For Y = 2 To Sheets.Count
Sheets("" & Cells(Y - 1, 1)).Move Before:=Sheets(Y)
Sheets("Liste").Select
If Sheets("Liste").Cells(Y - 1, 2) = "Gizli" Then
Sheets("" & Cells(Y - 1, 1)).Visible = False
End If
Next
Application.DisplayAlerts = False
Sheets("Liste").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
[code]
İyi çalışmalar DUAYEN...

(10/04/2012, 15:36)DUAYEN yazdı: [ -> ]Merhaba birde bu kodu denermisiniz.İki tane modul ekleyelim ve bu modüllere ayrı ayrı sayfa ekleyeceğiz birde sayafa isimlerini sen kendine göre değiştirirsin.
Anasayfaya aşağıdaki kodu ekleyelim.

Kod:

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim SAYFA_ADI As String
Dim BUL As Range, ADRES As String
Dim SATIR As Long
If Intersect(Target, [A4:A65536]) Is Nothing Then Exit Sub
Cancel = True
Cells.EntireColumn.AutoFit
SAYFA_ADI = Target.Text
If SAYFA_ADI = "" Then Exit Sub
If SAYFA(SAYFA_ADI) Then
Set BUL = Columns(3).Find(SAYFA_ADI)
If Not BUL Is Nothing Then
ADRES = BUL.Address
Do
With Sheets(SAYFA_ADI)
SATIR = .[A65536].End(3).Row + 1
.Cells(SATIR, 1) = SATIR - 2
.Cells(SATIR, 2) = Cells(BUL.Row, 2)
.Cells(SATIR, 3) = Cells(BUL.Row, 4)
.Cells(SATIR, 4) = Cells(BUL.Row, 6)
.Cells(SATIR, 5) = Cells(BUL.Row, 7)
.Cells(SATIR, 6) = Cells(BUL.Row, 8)
.Cells(SATIR, 7) = Cells(BUL.Row, 9)
SATIR = SATIR + 1
End With
Set BUL = Columns(3).FindNext(BUL)
Loop While ADRES <> BUL.Address And Not BUL Is Nothing
Sheets(SAYFA_ADI).Cells.EntireColumn.AutoFit
End If
Else
Sheets("ŞABLON").Visible = True
Sheets("ŞABLON").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = SAYFA_ADI
ActiveSheet.[A1] = Target
Set BUL = Columns(3).Find(SAYFA_ADI)
If Not BUL Is Nothing Then
ADRES = BUL.Address
Do
With ActiveSheet
SATIR = .[A65536].End(3).Row + 1
.Cells(SATIR, 1) = SATIR - 2
.Cells(SATIR, 2) = Cells(BUL.Row, 2)
.Cells(SATIR, 3) = Cells(BUL.Row, 4)
.Cells(SATIR, 4) = Cells(BUL.Row, 6)
.Cells(SATIR, 5) = Cells(BUL.Row, 7)
.Cells(SATIR, 6) = Cells(BUL.Row, 8)
.Cells(SATIR, 7) = Cells(BUL.Row, 9)
SATIR = SATIR + 1
End With
Set BUL = Columns(3).FindNext(BUL)
Loop While ADRES <> BUL.Address And Not BUL Is Nothing
Sheets(SAYFA_ADI).Cells.EntireColumn.AutoFit
End If
End If
Sheets("ŞABLON").Visible = False
SAYFALARI_ALFABETİK_SIRALA
Sheets("ANA SAYFA").Select
Set BUL = Nothing
Application.ScreenUpdating = True
MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

Mödül 1 yazılacak olan kod

Kod:

Option Explicit

Function SAYFA(SAYFAADI As String) As Boolean
On Error Resume Next
SAYFA = CBool(Len(Worksheets(SAYFAADI).Name) > 0)
End Function

Modül 2 yazılacak kod
[/code]
Option Explicit

Sub SAYFALARI_ALFABETİK_SIRALA()
Dim X As Integer, Y As Integer, Say As Integer
Application.ScreenUpdating = False
Sheets(1).Select
Say = Sheets.Count
If Say < 2 Then Exit Sub
Sheets.Add , After:=Sheets("ANA SAYFA")
ActiveSheet.Name = "Liste"
For X = 2 To Sheets.Count
Sheets("Liste").Cells(X - 1, 1) = Sheets(X).Name
If Sheets(X).Visible = False Then
Sheets(X).Visible = True
Sheets("Liste").Cells(X - 1, 2) = "Gizli"
End If
Next
[A:B].Sort Key1:=Range("A2"), Order1:=xlAscending
[A1].Select
For Y = 2 To Sheets.Count
Sheets("" & Cells(Y - 1, 1)).Move Before:=Sheets(Y)
Sheets("Liste").Select
If Sheets("Liste").Cells(Y - 1, 2) = "Gizli" Then
Sheets("" & Cells(Y - 1, 1)).Visible = False
End If
Next
Application.DisplayAlerts = False
Sheets("Liste").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
[code]
İyi çalışmalar DUAYEN...

Teşekkürler...