Otomatik çalışan makroyu düğmeli hale getirmek

[mbattal]

Arkadaşlar Merhaba,
Aşağıda yazdığım makro otomatik olarak çalışıyor. Yani K sütununa ÜRETİLDİ yazdığımda otomatik olarak o satırı kesip diğer sayfaya atıyor. Ben bunu otomatik değilde bir düğmeye bağlamak istiyorum. Düğmeye tıkladığımda K sütununda hangi satırlarda ÜRETİLDİ yazarsa o satırları siparişler sayfasından kesip siparişler2 sayfasına atmasını istiyorum.
Yardım edersenizi çok sevinirim.



Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [k2:k100]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target.Value = "ÜRETİLDİ" Then
Set s1 = Sheets("siparişler")
Set s2 = Sheets("siparişler2")
sat = s2.[b65536].End(3).Row + 1
sno = s1.Cells(Target.Row, "g").Value
s2.Range(s2.Cells(sat, 2), s2.Cells(sat, 11)).Value = s1.Range(s1.Cells(Target.Row, 2), s1.Cells(Target.Row, 11)).Value
Application.EnableEvents = False
Target.EntireRow.Delete Shift:=xlUp
Application.EnableEvents = True
Set s1 = Nothing
Set s2 = Nothing
MsgBox sno & " Nolu Sipariş Sipariş2 Sayfasına Aktarıldı.", vbInformation + vbDefaultButton1 + vbOKOnly, "UYARI"
[h2].Select
End If
End Sub

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Option Explicit

Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, Satir As Long, Veri As Range, Alan As Range
    
    Set S1 = Sheets("siparişler")
    Set S2 = Sheets("siparişler2")
    Satir = S2.Cells(Rows.Count, 2).End(3).Row + 1
    
    For Each Veri In S1.Range("K2:K100")
        If Veri.Value = "ÜRETİLDİ" Then
            S2.Range("B" & Satir & ":K" & Satir).Value = S1.Range("B" & Veri.Row & ":K" & Veri.Row).Value
            Satir = Satir + 1
        End If
    Next
    
    For Each Veri In S1.Range("K2:K100")
        If Veri.Value = "ÜRETİLDİ" Then
            If Alan Is Nothing Then
                Set Alan = Veri
            Else
                Set Alan = Union(Alan, Veri)
            End If
        End If
    Next
    
    If Not Alan Is Nothing Then Alan.EntireRow.Delete

    Set Alan = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "Siparişler aktarılmıştır.", vbInformation
End Sub

 

[mbattal]

Sayın Korhan Bey,
Öncelikle ilginiz ve emeğiniz için çok teşekkür ederim. Gönderdiğiniz kodu dosyama uyarlayıp inceledim. Fakat "K" sütununda birden fazla "ÜRETİLDİ" satırı olduğunda sadece en son satıra işlem yapıyor. Benim istediğim "K" sütununda ne kadar "ÜRETİLDİ" satırı varsa hepsini aynı anda kaldırıp diğer sayfaya atmasıydı.
Sizi fazla uğraştırmayacaksa bu kodu bu şekilde revize etmenizi rica edebilirmiyim.
Teşekkürler.

 

[Korhan Ayhan]

Kusura bakmayın küçük bir detayı atlamışım. Üstteki mesajımda ki kodu revize ettim. Tekrar deneyiniz.

 

[mbattal]

Korhan Bey,
Aktarmada sorun yok çok güzel fakat silmede sorun var "K" sütununda "ÜRETİLDİ" yazan satırların hepsini silmiyor. 3 adet olarak deneme yaptım 3 satırıda aktardı fakat 2 satırı sildi. Dolayısıyla aynı satır her iki sayfada da kalmış oluyor.
Teşekkürler.

 

[mbattal]

Hatta Korhan Bey yeni bir deneme yaptım.
10 satıra "ÜRETİLDİ" yazdım hepsini aktardı fakat 5 satırı sildi yani yarısını. 14 satırda 7 satır sildi, 5 satırda 3 satır sildi

 

[mbattal]

Korhan Bey,
Bakabildiniz mi acaba?

 

[Korhan Ayhan]

Gerekli düzeltmeyi yaptım. Tekrar deneyiniz.

 

[mbattal]

Teşekkür ederim.