SATIR EKLE MAKROSU

[polis-53]

Merhaba arkadaşlar ekte gönderdiğim kod da A kolonuna veri girdiğimde alta satır ekliyor.
sorun yok fakat A kolonuna veri girip enter tuşuna bastığımda A satırındaki förmüllerimi siliyor bu förmüller silinmesin diye ne yapmalıyım.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo son
If Intersect(Target, Range("SonSatır")) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Target.EntireRow.Insert Shift:=xlDown
Target.Offset(-1, 0) = Target
Target.Offset(-1, 1).Select
Target.Value = ""
son:
End Sub

 

[muhasebeciyiz]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim affRows As Range
On Error GoTo son
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Set affRows = Intersect(Target.EntireRow, Range("B"))
If Not affRows Is Nothing Then
affRows.ClearContents
End If
Target.Offset(, 1).Resize(, 3).Formula = "formülünüzü buraya yazınız" ' Your formulas go here
son:
Application.EnableEvents = True
End Sub

B3, C3 ve D3 hücrelerindeki formülleriniz ekleyebilirsiniz

 

[Muzaffer Ali]

Merhaba.

Dosyanızı görmediğim için net yanıt veremiyorum fakat sanırım aşağıdaki alternatif kod işinizi görecektir.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("SonSatır")) Is Nothing And Target.Value <> "" Then
        Target(2, 1).EntireRow.Insert
    End If
End Sub

 

[polis-53]

Merhaba gönderdiğin kod a kolonuna veri girerken hata veriyor.
benim istediğim
A kolonuna veri girdiğimde alta satır ekliyor.
örneğin A3 hücresine veri girildiğinde B3, C3 , D3 hücrelerindeki förmüller siliniyor.
eklediği satırda sorun yok

 

[muhasebeciyiz]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim affRows As Range
On Error GoTo son
If Intersect(Target, Me.Columns("A")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Set affRows = Intersect(Target.EntireRow, Me.Range("B"))
If Not affRows Is Nothing Then
affRows.ClearContents
End If
Target.Offset(, 1).Resize(, 3).Formula = Target.Offset(-1, 1).Resize(, 3).Formula
son:
Application.EnableEvents = True
End Sub

Deneyiniz

 

[polis-53]

tekrar merhabalar ekte gönderdiğim dosyada toplam satırının üzerine satır ekliyor dosyadan anlaşılacağı üzere A9 hücresine veri girdiğimde bir toplam satırının üzerine satır ekliyor ancak A9 satırındaki renkli hücreler förmüllü bu formülleri siliyor.

 

[polis-53]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim affRows As Range
On Error GoTo son
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Set affRows = Intersect(Target.EntireRow, Range("B"))
If Not affRows Is Nothing Then
affRows.ClearContents
End If
Target.Offset(, 1).Resize(, 3).Formula = "formülünüzü buraya yazınız" ' Your formulas go here
son:
Application.EnableEvents = True
End Sub

B3, C3 ve D3 hücrelerindeki formülleriniz ekleyebilirsiniz

Target.Offset(, 1).Resize(, 3).Formula = "formülünüzü buraya yazınız" ben bu hücrelere düşeyara ile veri çekiyorum

 

[muhasebeciyiz]

5 nolu mesajı deneyiniz

 

[Muzaffer Ali]

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target(2, 1) = "TOPLAM" And Target.Value <> "" Then
        Target(2, 1).EntireRow.Insert
        Cells(Target.Row, "C").FillDown
        Cells(Target.Row, "E").FillDown
    End If
    Application.EnableEvents = True
End Sub

 

[polis-53]

Cevap veren tüm arkadaşkara teşekkür ederim 9 nolu mesaj işimi gördü.
Kalın sağlıcakla.

 

[polis-53]

Arkadaşlar 1 soru daha sorabilirmiyim formüllü hücreleri korumaya aldığım zaman kod çalışmıyor nasıl çalıştırabilirim.

 

[Muzaffer Ali]

Sayfa adlarını ve şifreleri düzenleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Worksheets("SayfaAdı").Unprotect "şifre"
    If Target(2, 1) = "TOPLAM" And Target.Value <> "" Then
        Target(2, 1).EntireRow.Insert
        Cells(Target.Row, "C").FillDown
        Cells(Target.Row, "E").FillDown
    End If
    Worksheets("SayfaAdı").Protect "şifre"
    Application.EnableEvents = True
End Sub