Sayfa1 den Veri Aktarma Makrosu

[akmes]

Selamlar,

Arkadaşlar ekteki dosya da Evren hocamın yazmış olduğu bir makro var.A2 hücresine takım ismi yazdığımızda sayfa1 den o takıma ait sondan başa 6 maçın sonuçlarını sayfa2 ye getiriyor.Benim isteğim A12 hücresinde de aynı makrodan yararlanıp bir takımın daha sonuçlarını getirmek.Yardımlarınız için şimdiden çok teşekkür ederim.

 

[akmes]

Ben biraz bir çalışma yaptım benimkinde her ikiside bağımsız çalışmıyor.A2 de A12 de ne girersem alttaki dökümleri aynı oluyor.İlgili kod çalışmam ekte neresinde yanlışlık var bilgisi olan varmıdır.Kırmızı yazdığım kısımla ilgili doğru kodu bulamıyorum gibi; yardımlarınız için şimdiden teşekkür ederim.

Sayfa2 nin kod bölümünde;

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2,a12]) Is Nothing Then Exit Sub Range("A4:F9").ClearContents
If Target.Value = "" Then
Range("A14:F19").ClearContents
MsgBox "A2 hücresi boş." & vbLf & "İşlem İptal edildi!" & vbLf & "A2 Hücresine bir Takım adı giriniz", vbCritical, "U Y A R I -- E V R E N"
Exit Sub
End If
Call bul_59(Target.Value)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Modülde ise;

Option Base 1
Sub bul_59(ByRef takim As String)
'Coder : evrengizlen@hotmail.com
Dim list(), myarr(), sat As Long, i As Long, k As Byte, deg1 As String
Dim deg2 As String, say As Byte
sat = Sheets("sayfa1").Cells(65536, "A").End(xlUp).Row
If sat < 6 Then Exit Sub
takim = UCase(Replace(Replace(takim, "i", "İ"), "ı", "I"))
list = Sheets("Sayfa1").Range("A6:F" & sat).Value
ReDim myarr(1 To 6, 1 To 6)
For i = UBound(list) To LBound(list) Step -1
deg1 = UCase(Replace(Replace(list(i, 3), "i", "İ"), "ı", "I"))
deg2 = UCase(Replace(Replace(list(i, 4), "i", "İ"), "ı", "I"))
If takim = deg1 Or takim = deg2 Then
say = say + 1
For k = 1 To 6
myarr(say, k) = list(i, k)
Next k
End If
If say >= 6 Then Exit For
Next i
Erase list()
Range("A4").Resize(6, 6) = myarr()
Range("A14").Resize(6, 6) = myarr()
Erase myarr()
MsgBox "işlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[akmes]

Sorumun hala güncel?

 

[halit3]

Sorumun hala güncel?

ekli dosyayanızı kontrol ediniz.

 

[akmes]

ekli dosyayanızı kontrol ediniz.

Hocam çok sağolun tam istediğim gibi , emeğinize sağlık.

 

[halit3]

Hocam çok sağolun tam istediğim gibi , emeğinize sağlık.

iyi çalışmalar