satır ekleme koşulu

[ikikan]

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Columns(2).EntireRow.Hidden = False
Set Aralik = Range("a6:b" & [a65536].End(3).Row)
Set Bul = Aralik.Find("Tamam", LookIn:=xlValues, lookat:=xlWhole)
If Not Bul Is Nothing Then
Adres = Bul.Address
Do
Set Bul = Aralik.FindNext(Bul)
Bul.EntireRow.Hidden = True
Loop While Not Bul Is Nothing And Bul.Address <> Adres
MsgBox "İŞLEM BİTİ.", vbInformation, "PEGEM MÜHENDİSLİK"
End If
End Sub

Sub YAPILAN()
Application.ScreenUpdating = False
sonsat1 = [SERVİSFORMU!a65536].End(3).Row + 1
Rows(sonsat1).Insert Shift:=xlDown
Range("A" & sonsat1 & ":B" & sonsat1).FillDown
Range("C" & sonsat1 & ":J" & sonsat1).FillDown
Range("K" & sonsat1 & ":AB" & sonsat1).FillDown
Range("AC" & sonsat1 & ":AD" & sonsat1).FillDown
Range("AE" & sonsat1 & ":AI" & sonsat1).FillDown
Range("AJ" & sonsat1 & ":AN" & sonsat1).FillDown
End Sub

arkadaşlar bu iki makrto yu birleştirmek mümkünmü
sonuc şöyle cıkması gerekiyor ( ab sütünuna tamam yazıldıgında tama yazılan satırın altına bir satır eklemesi gerekiyor )

 

[Korhan Ayhan]

Selamlar,

Sayfanızın kod bölümüne aşağıdaki kodu uygulayıp denermisiniz. AB sütununda herhangibir hücreye TAMAM yazdığınızda satır eklenir.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("AB6:AB65536")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If UCase$(Target) = "TAMAM" Then Rows(Target.Row + 1).Insert
Son:
    Application.EnableEvents = True
End Sub

 

[ikikan]

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, Range("AB6:AB65536")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If UCase$(Target) = "TAMAM" Then Rows(Target.Row + 1).Insert
Son:
Application.EnableEvents = True
End Sub

denedim ama birşey olmadı thisWorkbook sayfasına ve sayfa kod bolümündede denedim sonuç aynı aktifleşmiyor

 

[ikikan]

Selamlar,

Sayfanızın kod bölümüne aşağıdaki kodu uygulayıp denermisiniz. AB sütununda herhangibir hücreye TAMAM yazdığınızda satır eklenir.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("AB6:AB65536")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If UCase$(Target) = "TAMAM" Then Rows(Target.Row + 1).Insert
Son:
    Application.EnableEvents = True
End Sub

Arkadaşlar bu kodu Workbook için düzelemek mümkünmü ?

 

[Orion1]

Nedense şu satır ve sütun ekleme işlerine bir türlü ısınamadım.
Bana çok itici geliyor.
İşlerimi satır ve sütun eklemden hallediyorum.

 

[ikikan]

Nedense şu satır ve sütun ekleme işlerine bir türlü ısınamadım.
Bana çok itici geliyor.
İşlerimi satır ve sütun eklemden hallediyorum.

evren bey bende satır ve sutunları cok severim nedense
her yiğidin bir yoğut yiyişi vardır değilmi ...
dikkatimi çekti uzun zaman cevap gelmese hemen siz cevap veriyorsunuz neden acaba?

 

[ikikan]

Selamlar,

Sayfanızın kod bölümüne aşağıdaki kodu uygulayıp denermisiniz. AB sütununda herhangibir hücreye TAMAM yazdığınızda satır eklenir.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("AB6:AB65536")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If UCase$(Target) = "TAMAM" Then Rows(Target.Row + 1).Insert
Son:
    Application.EnableEvents = True
End Sub

korhan bey acaba bu kodu her sayfa için uyarlamak mümkünmüdür
ayrıca tamam yazınca eklesin x yazınca silmesi mümkünmü

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

Kullanılan kod; (ThisWorkbook bölümüne uygulayın.)

Option Explicit
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("AB6:AB65536")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If UCase$(Target) = "TAMAM" Then
        Rows(Target.Row + 1).Insert
    ElseIf UCase$(Target) = "X" Then
        Rows(Target.Row + 1).Delete
    End If
Son:
    Application.EnableEvents = True
End Sub