Sayfalardaki Verileri Tek Sayfada Kaydetme

[isteobenim]

Merhaba,

Ek örnekte belirtilen gibi Sayfa1,Sayfa2,Sayfa3 e son boş satıra veri girişi olduğunda LİST sayfasında gelmesini nasıl sağlayabilirim.
Yardımcı olabilecek arkadaşlar var ise ilgilerinizi rica ederim.

 

[çıtır]

Dosyanız.Uzun bir formül oldu ,belki daha kısa olabilir.

 

[isteobenim]

Üstadım, teşekkür ederim, emeğine sağlık.
Bu arada bende alternatif çözüm olarak makro uyarlama yapıyordum, belki ihtiyacı olan olur,
Bu arada formül yeni veri girildiğinde hangi sayfaya giriş olur ise oradaki satır sayısı kadar LİST sayfasında araya alıyor, yeni giriş olduğunda son boş satıra nasıl aldırabiliriz formül ile.

Sub SayfaAktar()
Dim S1 As Worksheet, Sayfalar As Worksheet, X As Integer
Set S1 = Sheets("Data")
Application.ScreenUpdating = False
For Each Sayfalar In ThisWorkbook.Worksheets
If Sayfalar.Name <> "Data" Then
Sayfalar.Select
Range("A2:W" & Cells(65536, 3).End(xlUp).Row).Select
Selection.Copy
Range("A1").Select
S1.Select
sat = Cells(65536, "A").End(xlUp).Row + 1
Cells(sat, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.DisplayAlerts = False
End If
Next
For X = 1 To Sheets.Count
S1.Range("A1").Select
Application.ScreenUpdating = True
Next
End Sub

 

[hamitcan]

Aşağıdaki kodu, sayfanın ThisWorkbook kısmına ekleyin.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Column > 3 Then Exit Sub
    If Sh.Name = "LİST" Then Exit Sub
    x1 = Sh.[a65536].End(3).Row
    x2 = Sheets("LİST").[a65536].End(3).Row + 1
    If WorksheetFunction.CountA(Rows(x1)) = 3 Then
        Sheets("LİST").Rows(x2) = Sh.Rows(x1).Value
    End If
End Sub

 

[isteobenim]

Hamitcan Bey, Teşekkür ederim,

Burada sayfa sayısının dinamik olacağını düşünüp işlemi döngüye bağlamak istersen nasıl bir ekleme yapmamız gerekir.

 

[hamitcan]

İstediğiniz kadar sayfa ekleyebilirsiniz. Kod bu şekliyle çalışacaktır.