mert25
Yeni Üye
- Katılım
- 25 Ağu 2022
- Mesajlar
- 5
- En iyi yanıt
- 0
- Puanları
- 3
- Yaş
- 44
- Konum
- Erzurum
- Ad Soyad
- Yusuf Albayrak
- Office Vers.
- 2016
Merhabalar,
Ekteki dosyamda Ana Sayfada Aktar butonuna tıkladığımda AL5:AM5 hücrelerindeki veriler aşağıdaki kod ile Basketbol sayfasında aktarılıyor. Aktarma sonrası Ana Sayfadaki filtrenin kaldırılmasını istiyorum. Yardımcı olacak ustalara şimdiden teşekkür ederim.
Ekteki dosyamda Ana Sayfada Aktar butonuna tıkladığımda AL5:AM5 hücrelerindeki veriler aşağıdaki kod ile Basketbol sayfasında aktarılıyor. Aktarma sonrası Ana Sayfadaki filtrenin kaldırılmasını istiyorum. Yardımcı olacak ustalara şimdiden teşekkür ederim.
Kod:
Private Sub CommandButton3_Click()
Dim wsAnaSayfa As Worksheet
Dim wsBasketbol As Worksheet
Dim rngAnaSayfa As Range
Dim matchFound As Boolean
Dim i As Long
Dim matchedRow As Long
Set wsAnaSayfa = ThisWorkbook.Sheets("Ana Sayfa")
Set wsBasketbol = ThisWorkbook.Sheets("Basketbol")
' Ana Sayfa sayfasındaki veri aralığını belirle
Set rngAnaSayfa = wsAnaSayfa.Range("B6:F6")
Application.ScreenUpdating = False
' Her bir Ana Sayfa hücresi için Basketbol sayfasında eşleşen satırı bul ve Z:AE aralığındaki verileri yaz
matchFound = False
For i = 6 To wsBasketbol.Cells(wsBasketbol.Rows.Count, "B").End(xlUp).Row
If wsAnaSayfa.Cells(6, 2).Value = wsBasketbol.Cells(i, 2).Value And _
wsAnaSayfa.Cells(6, 3).Value = wsBasketbol.Cells(i, 3).Value And _
wsAnaSayfa.Cells(6, 4).Value = wsBasketbol.Cells(i, 4).Value And _
wsAnaSayfa.Cells(6, 5).Value = wsBasketbol.Cells(i, 5).Value And _
wsAnaSayfa.Cells(6, 6).Value = wsBasketbol.Cells(i, 6).Value Then
' Eşleşen satır bulunduğunda verileri kopyala
wsBasketbol.Range("Z" & i & ":AE" & i).Value = wsAnaSayfa.Range("AJ5:AO5").Value
matchFound = True
matchedRow = i ' Eşleşen satırın numarasını sakla
Exit For
End If
Next i
If Not matchFound Then
' Eşleşen satır bulunamadıysa, hata mesajı verebilirsiniz (isteğe bağlı)
MsgBox "Eşleşen satır bulunamadı: " & wsAnaSayfa.Cells(6, 2).Value & ", " & wsAnaSayfa.Cells(6, 3).Value & ", " & wsAnaSayfa.Cells(6, 4).Value & ", " & wsAnaSayfa.Cells(6, 5).Value & ", " & wsAnaSayfa.Cells(6, 6).Value
Else
' Eşleşen satır bulunduysa, imleci D sütunundaki hücreye yerleştir
wsBasketbol.Activate ' Basketbol sayfasını aktif hale getir
wsBasketbol.Cells(matchedRow, 4).Select
End If
Application.ScreenUpdating = True
End Sub