Makro'da Düzenleme

[1Al2Ver]

Merhaba,

GİRİŞ isimli çalışma sayfamda ;

Private Sub Worksheet_Change(ByVal Target As Range) ile başlayan bir kod var.

GİRİŞ isimli sayfaya 2 nci bir kodu (aşağıdaki kodu) yazınca ;

Private Sub Worksheet_Change(ByVal Target As Range) kodundan dolayı hata veriyor.

Aşağıdaki kodu MODÜL'e kaydedip GİRİŞ sayfasında etkin kılmak için kodda ne gibi bir düzeltme yapmam lazım.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X As Byte
    If Intersect(Target, [A2:F2]) Is Nothing Then Exit Sub
    If WorksheetFunction.CountA(Range("A2:F2")) = 6 Then
    Range("A2:F2").Insert Shift:=xlDown
    Range("A2:F2").Clear
        With Range("A2:F" & Range("A65536").End(3).Row)
            For X = 1 To 4
                .Borders(X).LineStyle = xlContinuous
            Next
        End With
    Range("A2").Select
    End If
End Sub

NOT ; Kod, en son F satırına veri girilince satır kaydırmaktadır.

Teşekkür ederim.

 

[Erdem Akdemir]

Örnek dosya ekleyebilir misiniz?

 

[1Al2Ver]

Örnek dosya ekleyebilir misiniz?

Sayın kuvari merhaba,

Öncelikle ilginiz için teşekkür ederim.

Dosya ek'tedir.

 

[YUSUF44]

İki kodu şu şekilde birleştirdim. F2'ye veri girildiğinde ilk kısım, F3 ve aşağısına veri girildiğinde ise ikinci kısım çalışıyor. Deneyip dönüş yaparsanız sevinirim:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X As Byte
    If Intersect(Target, [A2:F2]) Is Nothing Then GoTo 10
    If WorksheetFunction.CountA(Range("A2:F2")) = 6 Then
    Range("A2:F2").Insert Shift:=xlDown
    Range("A2:F2").Clear
        With Range("A2:F" & Range("A65536").End(3).Row)
            For X = 1 To 4
                .Borders(X).LineStyle = xlContinuous
            Next
        End With
    Range("A2").Select
    End If
10:
    If Intersect(Target, [F3:F65536]) Is Nothing Then Exit Sub
On Error GoTo son
If Target.Value = "" Then Exit Sub
sat = Sheets(Target.Offset(0, -4).Value).Cells(65536, "B").End(xlUp).Row + 1
Sheets(Target.Offset(0, -4).Value).Cells(sat, "A").Value = Target.Offset(0, -5).Value
Sheets(Target.Offset(0, -4).Value).Cells(sat, "B").Value = Target.Offset(0, -4).Value
Sheets(Target.Offset(0, -4).Value).Cells(sat, "C").Value = Target.Offset(0, -3).Value
Sheets(Target.Offset(0, -4).Value).Cells(sat, "D").Value = Target.Offset(0, -2).Value
Sheets(Target.Offset(0, -4).Value).Cells(sat, "E").Value = Target.Offset(0, -1).Value
Sheets(Target.Offset(0, -4).Value).Cells(sat, "F").Value = Target.Offset(0, 0).Value
son:

End Sub

 

[1Al2Ver]

Sayın Yusuf44 merhaba,

Çözüm için çok teşekkür ederim, denemelerimde bir sorunla karşılaşmadım.

Bir ricam daha olabilir mi ?

Veri kayıt edilmeye çalışıldığında (F2) açılmış sayfa yok ise, uyarı yapıp "Sayfa Yok! Açılsın mı? " diye sorup cevap "evet" ise yenisayfa açıp kayıt edebilir mi ?

Tekrar teşekkür ederim.