Dinamik Liste Birleştirme isimli içerikte, ilgili işlemin VBA kodları ile nasıl yapacağınızı öğreten bir Hazır Makro Kodu yer almaktadır.
[*]Microsoft Excel Objects yazısının solundaki + simgesini tıklayın ve hangi sayfada deneme yapacaksanız, o sayfanın adının üstüne çift tıklayın.
Kendinize basit veriler oluşturarak, çalışma mantığını inceleyebilirsiniz.
Faydalanılması temennisiyle
[*]Microsoft Excel Objects yazısının solundaki + simgesini tıklayın ve hangi sayfada deneme yapacaksanız, o sayfanın adının üstüne çift tıklayın.
Hazır Kod
VBA:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Set s1 = Sayfa1
Set s2 = Sayfa2
Set s3 = Sayfa3
If ActiveSheet.Name <> s1.Name And ActiveSheet.Name <> s2.Name Then Exit Sub
If Intersect(Target, [A:E]) Is Nothing Then Exit Sub
yeni = s3.Cells(Rows.Count, "A").End(xlUp).Row + 1
a = Target.Row
If Cells(a, "F") <> "" Then Exit Sub
If WorksheetFunction.CountBlank(Range("A" & a & ":E" & a)) = 0 Then
Application.EnableEvents = False
Range("A" & a & ":C" & a).Copy s3.Cells(yeni, "A")
Cells(a, "D").Copy s3.Cells(yeni, "D")
s3.Sort.SortFields.Clear
s3.Sort.SortFields.Add Key:=Range("A6:A" & yeni), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With s3.Sort
.SetRange Range("A2:D" & yeni)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Cells(a, "F") = yeni
Application.EnableEvents = True
End If
End SubAçıklama
Kodlar, A:E sütunlarında veri olan iki ayrı sayfadan herhangi bir tanesinde değişiklik yapıldığında, ilgili satırı üçüncü sayfaya aktarma işlevini görmektedir.Kendinize basit veriler oluşturarak, çalışma mantığını inceleyebilirsiniz.
Faydalanılması temennisiyle
