Örnek Dosyadaki Formülü Nasıl kısaltabilirim

[cocoa35]

Merhaba üstatlar, Örnek dosyada Sayfa1'de örneğin A satırında değişiklik olduğunda o satırı otomatikman Sayfa2 A satırına kopyalayan formül var ancak benim buradaki satır sayım 250 geçecek belki bu formül daha kısa olarak nasıl düzenlenebilir?

 

[Muzaffer Ali]

Merhaba.
Sayfa1 deki kodları silin aşağıdakileri ekleyin.
Sayfa1 A sütununda bir değişiklik yaptığınızda kod otomatik çalışıp kopyalayacaktır.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SonSatir As Long
    Dim Bak As Range
    For Each Bak In Target
        If Not Intersect(Bak, Range("A:A")) Is Nothing And Bak <> "" Then
            With Worksheets("Sayfa2")
                SonSatir = .Cells(Rows.Count, "A").End(xlUp).Row + 1
                Bak.EntireRow.Copy Worksheets("Sayfa2").Rows(SonSatir)
            End With
        End If
    Next
End Sub

 

[cocoa35]

Sn Muzaffer Ali bey ilginiz için çok teşekkür ediyorum, ancak benim istediğim Sayfa1 A5 Değişmişse A5 satırı komple Sayfa2 A5'e kopyalansın şu anki formül ile kopyalanıyor ancak dolu satırların altına kopyalıyor.

 

[dEdE]

Sayın @Muzaffer Ali'nin kodunu aşağıdaki değişikliklerle dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bak As Range
    For Each Bak In Target
        If Not Intersect(Bak, Range("A:A")) Is Nothing And Bak <> "" Then
            With Worksheets("Sayfa2")
                Bak.EntireRow.Copy Worksheets("Sayfa2").Rows(Target.Row)
            End With
        End If
    Next
End Sub

 

[cocoa35]

Tamam şimdi oldu sn dEde ve sn Ali bey çok teşekkürler.

 

[Muzaffer Ali]

O zaman aşağıdaki gibi olsa yeterli.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Target.EntireRow.Copy Worksheets("Sayfa2").Rows(Target.Row)
    End If
End Sub

 

[cocoa35]

O zaman aşağıdaki gibi olsa yeterli.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Target.EntireRow.Copy Worksheets("Sayfa2").Rows(Target.Row)
    End If
End Sub

Evet buda oldu peki ufak bir ekleme istesem çokmu olurum, satırın hepsini değilde örneğin A : F arasını sadece kopyalatabilirmisiniz?

 

[Muzaffer Ali]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        range("A" & target.row & ":F" & target.row ).Copy Worksheets("Sayfa2").Rows(Target.Row)
    End If
End Sub

 

[cocoa35]

Tamam oldu çok çok teşekkürler