Çalışan kod üzerinde değişiklik..

[policeman]

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [K:K]) Is Nothing Then Exit Sub
If Target.Row < 4 Then Exit Sub
If Target = "" Then Exit Sub
Dim SonKol As Integer
Dim SonSat As Long
Dim Sat As Long
Sat = Target.Row
SonSat = Sheets("teslim edilen siparişler").[A65536].End(3).Row + 1
SonKol = [IV4].End(1).Column
Application.EnableEvents = False
Range(Cells(Sat, "A"), Cells(Sat, SonKol)).Copy _
Sheets("teslim edilen siparişler").Range("A" & SonSat)
Rows(Sat).Delete Shift:=xlUp
Application.EnableEvents = True
Son:
End Sub

Yukarıdaki Sn. Necdet hocamıza ait kod ile K sütununa herhangi bir veri girildiğinde satırı istenen yere taşıyor..
Herhangi bir veri değilde TAMAM yazdığımızda taşımasını istiyorum..
Yardımınızı talep ediyorum..
Saygılarımla..

 

[vardar07]

Aşağıdaki satır:

If Target.Row < 4 Then Exit Sub

Yerine:

If Target.Row < >"TAMAM" Then Exit Sub

yazıp denermisiniz.

 

[Asri]

Aşağıdaki şekilde deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
   On Error GoTo Son
   If Intersect(Target, [K:K]) Is Nothing Then Exit Sub

  [B] if Target.value<>"TAMAM" then Exit Sub[/B]

   If Target.Row < 4 Then Exit Sub
   If Target = "" Then Exit Sub  
   Dim SonKol As Integer
   Dim SonSat As Long 
   Dim Sat As Long
   Sat = Target.Row
   SonSat = Sheets("teslim edilen siparişler").[A65536].End(3).Row + 1
   SonKol = [IV4].End(1).Column
   Application.EnableEvents = False
   Range(Cells(Sat, "A"), Cells(Sat, SonKol)).Copy _
           Sheets("teslim edilen siparişler").Range("A" & SonSat)
   Rows(Sat).Delete Shift:=xlUp
   Application.EnableEvents = True
  Son:
End Sub

 

[policeman]

İlginize teşekkürler,hayırlı akşamlar..