Sayfalar arası veri aktarımı

[gezgin-49]

Sayın Üstadlarım,
Sayfa1 de yaklaşık 43 mahalle adına göre 1000’den fazla veri var ve her mahalledeki kişi sayısı farklı,

Sayfa 2 de “A” mahallesini seçtiğimde sayfa1 deki verilerin Sayfa2’ye taşınması gerekiyor, bunun için nasıl bir kod yazmam lazım

Örneğin:
Sayfa1

B2=sıra numarası

C2=Adı Soyadı

D2=Baba Adı

E2=Mahalle Adı

F2=Sokak Adı

G2=Bina No

H2=Kapı No

Bu verilerin Sayfa 2 de

W2=Sıra No

X2=Adı Soyadı

Y2=Baba Adı

Z2=Mahalle Adı

AA2=Sokak Adı

AB2=Kapı No hücrelerine yazmasını istiyorum.

 

[PLİNT]

Merhaba
Ek dosyayı deneyiniz
https://dosyaup.com/d/MIOWCKLMYT

 

[PLİNT]

Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Cells.Count <> 1 Then Exit Sub
If Target.Address <> "$U$2" Then Exit Sub
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.Range("W2:AB" & Rows.Count) = Empty
s1.AutoFilterMode = False
x = s1.Cells(Rows.Count, "E").End(3).Row
s1.Range("B1:H" & x).AutoFilter Field:=4, Criteria1:=s2.[U2].Text
s1.Range("B2:F" & x).SpecialCells(xlCellTypeVisible).Copy
s2.[W2].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
s1.Range("H2:H" & x).SpecialCells(xlCellTypeVisible).Copy
s2.[AB2].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
s1.AutoFilterMode = False
Application.CutCopyMode = False
Target.Select
End Sub

 

[gezgin-49]

Sayın Üstadım kodları sayfanın kod sayfasına yapıştırdım, kodları çalıştırmak için bir düğmeye mi atamam lazım

 

[PLİNT]

Örnek dosyadaki gibi "Sayfa2" kod penceresine kodları yazın, "Sayfa2" "U2" hücresine "Mahalle adını" yazıp "enter" la çıkın.
https://dosyaup.com/d/MIOWCKLMYT

 

[gezgin-49]

Sayın Üstadım Allah sizden razı olsun, çok güzel olmuş, ellerinize emeğinize sağlık, sadece ufak bir problem var, listenin ilk sırasındaki ismi her mahallede yeniden yazıyor

 

[PLİNT]

Sizin dosyada "sayfa1" de "mahalle" isimleri kaçıncı satırdan başlıyor?

 

[gezgin-49]

2.ci satırdan

 

[PLİNT]

Aşağıdaki değişik kodlada deneyebilirsiniz

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lis As Variant, kom As Variant, i As Long
Dim s1 As Worksheet, s2 As Worksheet, x As Long, n As Long
If Selection.Cells.Count <> 1 Then Exit Sub
If Target.Address <> "$U$2" Then Exit Sub
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.Range("W2:AB" & Rows.Count) = Empty
s1.AutoFilterMode = False
x = s1.Cells(Rows.Count, "E").End(3).Row
n = 1
lis = s1.Range("B2:H" & x).Value
ReDim kom(1 To 6, 1 To 1)
For i = LBound(lis) To UBound(lis)
If lis(i, 4) = s2.[U2].Text Then
kom(1, n) = lis(i, 1)
kom(2, n) = lis(i, 2)
kom(3, n) = lis(i, 3)
kom(4, n) = lis(i, 4)
kom(5, n) = lis(i, 5)
kom(6, n) = lis(i, 7)
n = n + 1
ReDim Preserve kom(1 To 6, 1 To n)
End If
Next
If n = 1 Then MsgBox "Aranan Mahalle adı bulunamadı": Exit Sub
Sayfa2.Cells(2, "W").Resize(n - 1, 6) = Application.Transpose(kom)
Erase lis: Erase kom
End Sub