Otomatik Hücreye Veri Girişi

[askm]

Hayırlı geceler. Sayfa1 de bir liste mevcut. A sütununda anabaşlık, B sütununda alt başlık, C sütununda liste mevcut. Listede her alt başlıktan Max 30 tane var.
Sayfa2 de A1 sutununda anabaşlık, hemen altında B sütununda altbaşlık,onun altında C sütununda da liste olacak şekilde aktar butonu nasıl yapabilirim. Teşekkürler.

 

[askm]

Örnek dosyayı ekliyorum. 2 Sayfa mevcut. 1. Sayfada asıl liste, 2.Sayfa ise aktar butonuna basınca olmasını istediğim hali.

 

[ÖmerBey]

Merhaba,
Sayfa isimlerini kendinize uyarlayarak kodu deneyiniz...

Sub KOD()
Set s1 = Sheets("[COLOR="Red"]Asıl Liste[/COLOR]")
Set s2 = Sheets("[COLOR="Red"]Sayfa2[/COLOR]")
s2.Range("A:C").ClearContents
For a = 2 To s1.Range("A65500").End(3).Row
    If s1.Cells(a, "A") <> s1.Cells(a - 1, "A") Then
        s = s + 4
        s2.Cells(s, "A") = s1.Cells(a, "A")
        s = s + 1
        s2.Cells(s, "B") = s1.Cells(a, "B")
        s = s + 1
        sıra = 1
        s2.Cells(s, "B") = sıra
        sıra = sıra + 1
        s2.Cells(s, "C") = s1.Cells(a, "C")
        s = s + 1
    ElseIf s1.Cells(a, "A") = s1.Cells(a - 1, "A") And s1.Cells(a, "B") <> s1.Cells(a - 1, "B") Then
        s = s + 2
        s2.Cells(s, "B") = s1.Cells(a, "B")
        s = s + 1
        sıra = 1
        s2.Cells(s, "B") = sıra
        sıra = sıra + 1
        s2.Cells(s, "C") = s1.Cells(a, "C")
        s = s + 1
    Else
        s2.Cells(s, "B") = sıra
        sıra = sıra + 1
        s2.Cells(s, "C") = s1.Cells(a, "C")
        s = s + 1
    End If
Next
s2.Rows("2:3").Delete
End Sub

 

[askm]

Kodu denedim ama "Variable not defined" hatası veriyor.

 

[askm]

Başına
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim a As Integer
Dim s As Integer
Dim sira As Integer
ekledim.

 

[ÖmerBey]

Muhtemelen kod tanımlamayı (Option Explicit) şart koştuğunuz için bu hatayı alıyorsunuz.
Kodların başına aşağıdaki tanımlama satırını ekleyiniz.

Dim s1 As Worksheet, s2 As Worksheet, a As Integer, s As Integer, sıra As Integer

 

[ÖmerBey]

Sonradan farkettim zaten yazmışsınız ama sizin yazdığınızda "sira" var kod da ise "sıra" yazıyor; noktasız.
Ya da sayfa başında yer alan Option Explicit kodunu silin.

 

[askm]

Çok teşekkür ederim ilginiz için.