satır eklemek

[ekrema4]

Merhaba Ben Ekrem
Arkadaslar ekte gonderdıgım "satır ekle" makrosunu ben 7 sanıyede bır olarak ayarladım fakat bunu degıstırmek ıstıyorum. 7 sanıyede bır yerıne G3 hucresı 0 ( sıfır ) dan 1 ( bır ) oldugunda bır satır eklemesını ıstıyorum yardımcı olabılırmısınız?

Sub strekle()
Application.OnTime Now + TimeValue("00:00:07"), "ekle"
End Sub

Sub ekle()

son = Range("K600").End(3).Row

If son < 3 Then
Cells(3, "N") = Cells(2, "N")
Cells(3, "K") = Cells(2, "K")
Cells(3, "L") = Cells(2, "L")
Cells(3, "M") = Cells(2, "M")
Exit Sub

End If

For i = 3 To son

If Cells(3, "K") = "" Then
Cells(3, "N") = Cells(2, "N")
Cells(3, "K") = Cells(2, "K")
Cells(3, "L") = Cells(2, "L")
Cells(3, "M") = Cells(2, "M")
Exit Sub
End If

Next
Cells(son + 1, "N") = Cells(2, "N")
Cells(son + 1, "K") = Cells(2, "K")
Cells(son + 1, "L") = Cells(2, "L")
Cells(son + 1, "M") = Cells(2, "M")

Call strekle
End Sub

 

[Ömer]

Merhaba,

Eski kodları silip Sayfa1 in kod bölümüne aşağıdaki kodları yazın.

[COLOR=blue]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]
 
[COLOR=blue]  If Intersect(Target, Range("G3")) Is Nothing Then Exit Sub[/COLOR]
 
   son = Range("K600").End(3).Row
 
[COLOR=blue]  If Target = 1 Then[/COLOR]
        If son < 3 Then
            Cells(3, "N") = Cells(2, "N")
            Cells(3, "K") = Cells(2, "K")
            Cells(3, "L") = Cells(2, "L")
            Cells(3, "M") = Cells(2, "M")
            Exit Sub
        End If
        For i = 3 To son
            If Cells(3, "K") = "" Then
                Cells(3, "N") = Cells(2, "N")
                Cells(3, "K") = Cells(2, "K")
                Cells(3, "L") = Cells(2, "L")
                Cells(3, "M") = Cells(2, "M")
                Exit Sub
            End If
        Next
        Cells(son + 1, "N") = Cells(2, "N")
        Cells(son + 1, "K") = Cells(2, "K")
        Cells(son + 1, "L") = Cells(2, "L")
        Cells(son + 1, "M") = Cells(2, "M")
 [COLOR=blue]   End If[/COLOR]
 
[COLOR=blue]End Sub[/COLOR]

.

 

[ekrema4]

İlginize teşekkür ederim, tam istediğim gibi olmuş.. Çok sağolun...