Sınıf grubuna göre sayfalara aktarma

[tgrl]

Merhaba arkadaşlar, ekte paylaştığım excel dosyasında olduğu gibi bir liste var. Liste içerisinde sınıf numaralarına göre sayfalara atamasını yapmasını istiyorum. ayrıca eklemeler oldukça o sınıfın içerinde aktarıp bilgileri alt alta sıralamaya devam etmesini istiyorum. yardımcı olmanızı talep ediyorum. iyi günler dilerim.

 

[Necdet]

Merhaba,
Aktarım yapıldıktan sonra sayfa1 den veriler silinecek mi?
Kod yazacak olan arkadaş bu durumu dikkate almalı.

 

[Necdet]

Tekrar merhaba,
Aşağıdaki kodlar veri aktardıktan sonra F sütununa X koyar.
Sonraki aktarımlarda bu sütun dolu ise aynı veriyi aktarmaz.

Kodları ilk aktarımda aktarılacak sayfaları siliniz, ki başlıkları da sayfaya eklensin.

Function SayfaVarYok(SayfaAd As String) As Boolean
    On Error Resume Next
    SayfaVarYok = CBool(Len(Worksheets(SayfaAd).Name) > 0)
[CODE]Public Sub Aktar()

Dim sh  As Worksheet, _
    ad  As String, _
    adt As Integer, _
    say As Long, _
    i   As Long, _
    j   As Long, _
    k   As Integer, _
    arr As Variant

Set sh = Sheets(1)

i = sh.Cells(Rows.Count, "A").End(3).Row

arr = sh.Range("A1:F" & i).Value

For i = 2 To UBound(arr, 1)
    If arr(i, 6) = "" Then
        ad = arr(i, 2)
        If SayfaVarYok(ad) = False Then
            adt = adt + 1
            Sheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = ad
            Sheets(ad).Range("A1").Resize(1, 5) = arr
        End If
        j = Sheets(ad).Cells(Rows.Count, "A").End(3).Row + 1
        For k = 1 To 5
            Sheets(ad).Cells(j, k) = arr(i, k)
        Next k
        Sheets(ad).UsedRange.Columns.AutoFit
        arr(i, 6) = "X"
        say = say + 1
    End If
Next i

With sh
    .Select
    .Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End With

MsgBox say & " Adet Satır Aktarılmıştır. Yeni Açılan Sayfa Sayısı : " & adt

End Sub

End Function[/CODE]

 

[tugkan]

Hangi Excel versiyonunu kullanıyorsunuz yazılı değil.
Bir ihtimal Excel 365 kullanıyorsanız, her sayfaya aşağıdaki formülü bir kez yazmanız yeterli olur.

=FİLTRE(Sayfa1!A2:İNDİS(Sayfa1!E:E;KAÇINCI(9^99;Sayfa1!E:E));Sayfa1!B2:İNDİS(Sayfa1!B:B;KAÇINCI(9^99;Sayfa1!B:B))=SAYFA()-1)

 

[tgrl]

Çok teşekkür ederim hepinize.

 

[Korhan Ayhan]

Merhaba,

Profilinizde yazan sürüm bilgisindeki "1" değerini kullandığınız sürüme ve diline göre (bizlerdeki gibi) güncellerseniz daha faydalı olacaktır.

 

[Necdet]

Belki bizim bilmediğimiz yeni bir xl sürümüdür Korhan bey