Veri Kaydır

[1Al2Ver]

Merhaba,

D2:N2 aralığına veri girildikçe D2:N2 aralığı, D3:N3'e kayacak, dolayısıyla D2:N2 boşalacak,

Her yeni veri D2:N2'ye girilecek ve yine her defasında D2:N2 bir alt satıra kayacak,

Elde edilmek istenen ; Yeni veriyi her zaman D2:N2 aralığına girerek, aşağıya doğru bir çizelge (Örn.;D2:N500) oluşturmak,

Teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu bu işlemi yapmak istediğiniz sayfanın kod bölümüne uygulayıp denermisiniz. Satırları aşağıya doğru sürüklemek için D-N sütunları arası dolu olma koşulu kullanılmıştır.

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

 

[1Al2Ver]

Selamlar,

Aşağıdaki kodu bu işlemi yapmak istediğiniz sayfanın kod bölümüne uygulayıp denermisiniz. Satırları aşağıya doğru sürüklemek için D-N sütunları arası dolu olma koşulu kullanılmıştır.

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

Merhaba Korhan bey,

Çözüm için teşekkür ederim, süper olmuş, elinize sağlık,

Saygılarımla.