Userfomda listboxtaki listeye göre veri aktarma

[bilgemman]

Öncelikle merhaba

Benim elimde yaptığım ve hali hazırda kullandığım proje var ve ben buna yeni özellikler ekleme yapmak istiyorum.

Projede üretim formu sayfasına girdiğim verileri formu kaydet butonuna tıkladığım zaman hepsi diğer sayfalara kaydoluyor sıkıntı yok.Yapmak istediğim

Kesilen Ürünler sayfasındaSevkiyat Listesi Gir butonuna bastığımda çıkan userformda textboxa kasa no yazıp listboxa kaydediyorum ama alt alta 10 farklı kasa no girdiğim zaman sevket butonuna basınca listedeki kasa noya ait verileri kesilen ürünler sayfasından bulup o satırı sevkedilenler sayfasına kaydedilmesini ve kesilen ürünler sayfasından silinmesini istiyorum.Aşağıdaki kodları denediğimde kesilenler sayfasından siliyor ancak sevkedilenler sayfasına benim listeye aktardığım kasa nolar değil kesilen ürünler sayfasının en başındaki veri kaydoluyor.Bu konu ile ilgili yardımlarınızı rica ediyorum.

Not : Kasa No mükerrer kayıt içerebilir.Bugün yapılan kasa yarım kalıp daha sonra tamamlanabiliyor.

Private Sub CommandButton1_Click()

Dim sevkedilen As Worksheet
Dim kesilen As Worksheet

Set sevkedilen = Sheets("Sevkedilenler")
Set kesilen = Sheets("Kesilen Ürünler")
'--------------------------------------------------------------------------------
If ListBox1.ListCount = 0 Then
MsgBox "Kasa No Giriniz", vbCritical, "HATA"
Else

Dim son As Long, deg, i As Long, durum As Boolean, j As Integer, dongu As Integer, durum2 As Boolean
Dim a As Long

For a = ListBox1.ListCount - 1 To 0 Step -1
Dim say7 As Long
say7 = sevkedilen.Cells(65536, 1).End(xlUp).Row + 1
son = Cells(Rows.Count, "B").End(xlUp).Row
deg = Array(ListBox1.List(a))

Application.ScreenUpdating = False

For i = son To 2 Step -1

durum = False
  
For j = 0 To UBound(deg)
            If Cells(i, "B") Like deg(j) Then durum = True
            If durum = True Then Exit For
        Next j

     durum2 = True
    

    
    Dim alan7 As Range
    kesilen.Activate
    Set alan7 = kesilen.Range(kesilen.Cells(i, "B"), kesilen.Cells(i, "J")).SpecialCells(xlCellTypeConstants)
    alan7.Select
    Selection.Copy
    sevkedilen.Activate
    sevkedilen.Cells(say7, "B").PasteSpecial xlPasteValues
    Application.CutCopyMode = True
    kesilen.Activate
    If durum = True Then Rows(i).Delete Shift:=xlUp
    Application.ScreenUpdating = True




Next i
Next a
End If
If durum2 = True Then
ListBox1.Clear
MsgBox "Sevk işlemi başarılı", vbInformation, "BİLGİ"
End If

End Sub