sward175
Özel Üye
- Katılım
- 4 Şubat 2011
- Mesajlar
- 1,112
- Excel Vers. ve Dili
-
Excel Vers. ve Dili:
Microsoft Office 365 Tr 64 Bit
- Altın Üyelik Bitiş Tarihi
- 04-06-2024
Herkese Merhabalar,
Sayın, Hüseyin Emir Çoban' ın yapmış olduğu bir dosyadan aldığım kodu ( aşağıda) kendi dosyama uyguladım.
Ana sayfayı B sütunundaki isimlere göre sayfalara diziyor. Buraya kadar problem yok.
Dizmiş olduğu sayfalarda sıra numarası 1 den başlayarak 2,3,4,5, gibi gitmesi için kodda değişiklik yapılması hususunda yardımlarınızı rica ederim.
Saygılarımla,
sward175
Function SayfaVarMi(Sayfa As String) As Boolean
On Error Resume Next
SayfaVarMi = CBool(Len(Worksheets(Sayfa).Name) > 0)
End Function
Sub Kod()
Application.ScreenUpdating = False
Dim S1 As Worksheet
Set S1 = Sheets("Ana Liste")
Dim Sayfa As String
For a = 2 To S1.Cells(Rows.Count, "B").End(3).Row
Sayfa = S1.Cells(a, "B")
If Not SayfaVarMi(Sayfa) Then
Sheets.Add
ActiveSheet.Name = Sayfa
Sheets(Sayfa).Move After:=Sheets(Sheets.Count)
S1.Range("A1:I1").Copy Range("A1")
End If
sonsatır = Sheets(Sayfa).Cells(Rows.Count, "A").End(3).Row + 1
S1.Range(S1.Cells(a, "A"), S1.Cells(a, "I")).Copy _
Sheets(Sayfa).Cells(sonsatır, "A")
Next a
Application.ScreenUpdating = True
MsgBox " B i t t i "
End Sub
Sayın, Hüseyin Emir Çoban' ın yapmış olduğu bir dosyadan aldığım kodu ( aşağıda) kendi dosyama uyguladım.
Ana sayfayı B sütunundaki isimlere göre sayfalara diziyor. Buraya kadar problem yok.
Dizmiş olduğu sayfalarda sıra numarası 1 den başlayarak 2,3,4,5, gibi gitmesi için kodda değişiklik yapılması hususunda yardımlarınızı rica ederim.
Saygılarımla,
sward175
Function SayfaVarMi(Sayfa As String) As Boolean
On Error Resume Next
SayfaVarMi = CBool(Len(Worksheets(Sayfa).Name) > 0)
End Function
Sub Kod()
Application.ScreenUpdating = False
Dim S1 As Worksheet
Set S1 = Sheets("Ana Liste")
Dim Sayfa As String
For a = 2 To S1.Cells(Rows.Count, "B").End(3).Row
Sayfa = S1.Cells(a, "B")
If Not SayfaVarMi(Sayfa) Then
Sheets.Add
ActiveSheet.Name = Sayfa
Sheets(Sayfa).Move After:=Sheets(Sheets.Count)
S1.Range("A1:I1").Copy Range("A1")
End If
sonsatır = Sheets(Sayfa).Cells(Rows.Count, "A").End(3).Row + 1
S1.Range(S1.Cells(a, "A"), S1.Cells(a, "I")).Copy _
Sheets(Sayfa).Cells(sonsatır, "A")
Next a
Application.ScreenUpdating = True
MsgBox " B i t t i "
End Sub