Veriye göre ilgili sheete kayıt

[istanbulcahan]

Spor Özel, İl, Ulusal ve Uluslararası müsabakaların istatistiğini yapıyoruz. Otomatikman Özel müsabakalar özel sheetine, İl müsabakaları il sheetine, Ulusal müsabakalar Ulusal sheetine, Uluslar arası müsabakalar Uluslar arası sheetine kayıt etmesini istiyorum.

 

[Ömer]

Merhaba,

Sorunuzu destekleyen küçük bir örnek çalışma eklermisiniz.

 

[istanbulcahan]

Teşekkürler. Unutmuşum dosyayı değiştirince göndermeyi ilk konuda örnek çalışmayı gönderdim.

 

[Ömer]

Her kayıt işlemi sırasında sayfalardaki eski veriler silinecek mi, yoksa altından devam mı edecek?

 

[istanbulcahan]

Her kayıt işlemi sırasında sayfalardaki eski veriler silinecek mi, yoksa altından devam mı edecek?

Her kayıt işlemi sırasında sayfalardaki eski veriler silinmeyecek altından devam edecek

 

[Ömer]

Bu şekilde deneyin.

Sub SayfalaraAktar()
    
    Dim Su As Worksheet, i As Long, son As Long, syf As String
    
    Set Su = Sheets("U.ARASI-ULUSAL-İL-ÖZEL")
    
    Application.ScreenUpdating = False
    Su.Select
    
    For i = 2 To Cells(Rows.Count, "D").End(xlUp).Row
        syf = Cells(i, "D")
        If varmi(syf) Then
            son = Sheets(syf).Cells(Rows.Count, "D").End(xlUp).Row + 1
            Range("A" & i & ":F" & i).Copy Sheets(syf).Cells(son, "A")
            Sheets(syf).Cells(son, "A") = son - 1
        Else
            Sheets.Add After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = syf
            Su.Rows(1).Copy Sheets(syf).Range("A1")
            Su.Range("A" & i & ":F" & i).Copy Sheets(syf).Range("A2")
            Sheets(syf).Range("A2") = 1
            Su.Select
        End If
    Next i
    
End Sub
 
Function varmi(adi As String) As Boolean
    On Error Resume Next
    varmi = CBool(Len(Worksheets(adi).Name) > 0)
End Function

.

 

[istanbulcahan]

Verdiğiniz bu kodları ALT+F11 tuşu ile vbasice girip orada önce 1..sheete kopyaladım.yapıştırdım, olmadı. 2.shete kopyaladım.Yapıştırdım, olmadı.

 

[Ömer]

VBA ekranındaki Insert menüsünden Module ekleyip kodları eklenen bu module kopyalayın.

 

[istanbulcahan]

Dediğiniz giibi yaptım.Ama olmadı.

 

[Ömer]

Kodları uyguladığınız dosyayı eklermisiniz.

 

[istanbulcahan]

Normal dosya içeren ve makro dosya içeren olarak kaydettim.2 dosya ekte.

 

[kan-nas]

For i = 2 To Sheets("U.ARASI-ULUSAL-İL-ÖZEL").Range("d65536").End(3).Row
If Sheets("U.ARASI-ULUSAL-İL-ÖZEL").Cells(i, 4).Value = "ULUSAL" Then
Sheets("U.ARASI-ULUSAL-İL-ÖZEL").Rows(i).Copy Sheets("ULUSAL").Rows(Sheets("ULUSAL").Range("a65536").End(3).Row + 1)
End If
Next

Bu sadece ULUSAL olanlar için geçerlidir. Diğerlerini ekleyebilirsiniz.

 

[Ömer]

Normal dosya içeren ve makro dosya içeren olarak kaydettim.2 dosya ekte.

Herhangi bir sorun yok, tek yapmanız gereken "SayfalaraAktar" kodunu bir butona atayıp çalıştırmak.
Yalnız önce "ULUSLAR ARASI" sayfasının kod bölümündeki kodları silersiniz. Mükerrer kopyalama olmuş.

Eğer butona aktarmadan çalıştırmak istiyorsanız, Alt+F8 tuş kombinasyonu ile çalıştır butonu ile çalıştırabilirsiniz.

 

[istanbulcahan]

Herhangi bir sorun yok, tek yapmanız gereken "SayfalaraAktar" kodunu bir butona atayıp çalıştırmak.
Yalnız önce "ULUSLAR ARASI" sayfasının kod bölümündeki kodları silersiniz. Mükerrer kopyalama olmuş.

Eğer butona aktarmadan çalıştırmak istiyorsanız, Alt+F8 tuş kombinasyonu ile çalıştır butonu ile çalıştırabilirsiniz.

Diğer yandan makro buton kullanarak yapılsamı diye düşünüyorum. Mükemmel oldu. Yalnız burda bir şey sorayım. ALT+F8 ile çalıştırdıktan sonra gerekli veriler ilgili yerlere gidiyor. Ancak. Bu dosyayı kayıt edip, tekraren bir daha bu kombinizasyonu çalıştırınca eski verileri silmiyor.

 

[Ömer]

Diğer yandan makro buton kullanarak yapılsamı diye düşünüyorum. Mükemmel oldu. Yalnız burda bir şey sorayım. ALT+F8 ile çalıştırdıktan sonra gerekli veriler ilgili yerlere gidiyor. Ancak. Bu dosyayı kayıt edip, tekraren bir daha bu kombinizasyonu çalıştırınca eski verileri silmiyor.

Daha önce size bunu sorduğumda,

Her kayıt işlemi sırasında sayfalardaki eski veriler silinmeyecek altından devam edecek

Silinmeyecek demiştiniz. Eğer silinecekse kayıt sırasında mı yoksa söylediğiniz gibi dosyayı yeniden açarken mi silinecek.

 

[istanbulcahan]

Üstadım. Doğrudur.Bu hali tamamdır. Emeğine sağlık.