İsme göre sayfalara listele

[sward175]

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

 

[sward175]

Merhabalar,
Yapmış olduğum dosyayı eklersem konuyu daha iyi anlatmış olurum.
Sayfalarda A sütunundaki sıra numaraları 1 den başlayarak 2,3,4,5 gibi olmasını istiyorum.
Saygılarımla,
sward175

 

[PLİNT]

Merhaba
Sayfalar yeni oluşturulacaksa, daha önceden veri yoksa aşağıdaki gibi deneyin

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")
'-----------------------'
Sheets(Sayfa).Cells(sonsatır, "A") = sonsatır - 1 '<-----------veya bu satırın YERİNE
'----------------------'
Next a
Application.ScreenUpdating = True
MsgBox " B i t t i "
End Sub

Ama önceden veri varsa; "A" sütunu "A2" den itibaren düzenlenmesi gerek ise kodardaki işaretli satır yerine şu üç satırı kullanıp deneyiniz

f = Sheets(Sayfa).Cells(Rows.Count, "B").End(3).Row
Sheets(Sayfa).Cells(2, "A") = "1"
Sheets(Sayfa).Cells(2, "A").AutoFill Destination:=Sheets(Sayfa).Range("A2:A" & f), Type:=xlFillSeries

 

[sward175]

Sayın, PLİNT,
Kod gayet güzel çalışıyor,
Teşekkür eder nice güzel günler dilerim.
Saygılarımla,
sward175

 

[sward175]

Herkese, Merhabalar,
Ekli dosyadaki kodlarla Ana Liste sayfasının B sütunundaki Alıcı isimleri bazında yeni sayfa açarak bilgileri dağıtıyor.
Yapmak istediğim;
1. Açılan sayfalarının G sütununda "Teslim Edilen Eşyanın Miktarını" bir boşluk bırakarak toplasın. ( Hücreler sarı renk ile işaretlendi, fakat satır sayısı sürekli değişiyor.)
2. "Ana liste hariç sayfaları sil" butonuna basıldığında Ana Liste hariç sayfalar silinsin.
Yardımlarınızı rica ederim.
Saygılarımla,
sward175