Excel Dosyasında satırları aşağı yukarı taşıma

[Feylosof]

İyi akşamlar;
Konu ile alakalı ihtiyaç ortaya çıkınca forumda araştırma yaptım ve ekteki dosyayı buldum. Dosyadaki vba kodu sayın @Murat OSMA 'ya ait. Kodda benim ihtiyaç duyduğum ikinci konuyu eksik bırakıyor. O da şudur. Textboxtaki verileri aşağı yukarı kaydırma yaparken ben excel dosyasındaki veri ile birlikte (dosyayı da değiştirerek) tüm satırla taşınmasını istiyorum.
Yardımlarını esirgemeyecek olan excel uzmanlarına sonsuz teşekkürler.

 

[Feylosof]

Dosyada yanlış anlaşılmaya sebep olabilecek yerleri sildim veya düzelttim ve tekrar gönderiyorum.

 

[veyselemre]

Private Sub UserForm_Initialize()
    Cells(1, "H").Value = "Sıralama"
    Dim sut, s
    ListBox1.ColumnCount = 3
    s = 0
    For sut = 2 To Cells(65536, "A").End(3).Row
        ListBox1.AddItem
        ListBox1.List(s, 0) = Cells(sut, "A")
        ListBox1.List(s, 1) = Cells(sut, "B")
        ListBox1.List(s, 2) = Cells(sut, "C")
        Cells(sut, "H").Value = s
        s = s + 1
    Next
End Sub

Private Sub CommandButton1_Click()
    Dim i As Long, leaveAlone As Boolean, pos As Long
    pos = 0
    With ListBox1
        For i = 0 To .ListCount - 1
            leaveAlone = False
            If .Selected(i) Then
                If i = pos Then
                    leaveAlone = True
                End If
                pos = pos + 1
                If leaveAlone = False Then
                    Cells(i + 2, "H") = i - 1
                    Cells(i + 1, "H") = i
                    Call sirala
                    a = .List(i - 1, 0)
                    b = .List(i - 1, 1)
                    c = .List(i - 1, 2)
                    .List(i - 1, 0) = .List(i, 0)
                    .List(i - 1, 1) = .List(i, 1)
                    .List(i - 1, 2) = .List(i, 2)
                    .List(i, 0) = a
                    .List(i, 1) = b
                    .List(i, 2) = c
                    .ListIndex = i - 1
                    .Selected(i) = False
                    .Selected(i - 1) = True
                End If
            End If

        Next i
    End With
End Sub

Private Sub CommandButton2_Click()
    Dim i As Integer, leaveAlone As Boolean, pos As Long
    With ListBox1
        pos = .ListCount - 1
        For i = .ListCount - 1 To 0 Step -1
            leaveAlone = False
            If .Selected(i) Then
                If i = pos Then
                    leaveAlone = True
                End If
                pos = pos - 1
                If Not leaveAlone Then
                    Cells(i + 2, "H") = i + 1
                    Cells(i + 3, "H") = i
                    Call sirala

                    a = .List(i + 1, 0)
                    b = .List(i + 1, 1)
                    c = .List(i + 1, 2)
                    .List(i + 1, 0) = .List(i, 0)
                    .List(i + 1, 1) = .List(i, 1)
                    .List(i + 1, 2) = .List(i, 2)
                    .List(i, 0) = a
                    .List(i, 1) = b
                    .List(i, 2) = c
                    .ListIndex = i + 1
                    .Selected(i) = False
                    .Selected(i + 1) = True
                End If
            End If
        Next i
    End With
End Sub

Sub sirala()
    son = Cells(65536, "A").End(3).Row
    Range("A1:H" & son).Sort [H2], xlAscending, , , , , , xlYes
End Sub

Private Sub UserForm_Terminate()
    [H:H].ClearContents
End Sub

 

[Feylosof]

Sayın @veyselemre yanıtınız için çok teşekkür ediyorum. Kodu kendi dosyama uygulayıp sonucu size bildireceğim. Yardımınız çok makbule geçti varolun elinize yüreğinize sağlık...

 

[Feylosof]

Sayın @veyselemre kendi dosyamda gayet başarılı çalıştı. Küçük bir ricam olacak A sütunu sıra numarasından oluşmaktadır. Bu nedenle satır kaydırmada A sütununu dışarda tutacak şekilde kodu nasıl düzenlemeliyiz?

 

[veyselemre]

bilgisayar basinda degilim sirala prosedurunde range tanimini b1 den baslatin deneyin olmazsa ornek ekleyin yarin bakariz baska yardimci olan cikmazsa

 

[Feylosof]

Sayın @veyselemre biraz uğraştım ama iyice karıştırdım galiba

 

[veyselemre]

Worksheet_Change de yazdığınız kodları kaldırın bence, çok zorunlu kalmayınca kullanmayın bence hiç.
Bir tane formatlama için makro yazın. Bunu gereken yerlerde diğer makrolardan çağırın.

 

[Feylosof]

Sayın @veyselemre
Kodlarda aşağıda yazdığım satırları silmek suretiyle "A" sütununda bulunan sıra numaraların değişmesini devre dışı bırakmayı başardım.
Tüm yardım ve yol göstermeniz için sonsuz teşekkürler.

                    a = .List(i - 1, 0)
                    .List(i - 1, 0) = .List(i, 0)               
                    .List(i, 0) = a               
                    a = .List(i + 1, 0)                 
                    .List(i + 1, 0) = .List(i, 0)                   
                    .List(i, 0) = a
                  VE aşağıdaki kodu da şöyle yaptım oldu
Sub sirala()
    son = Cells(65536, "B").End(3).Row
    Range("B1:H" & son).Sort [H2], xlAscending, , , , , , xlYes
End Sub