Sayfa Seçimi userformundaki combobox1sayfasındaki B7 den AZ Aralığında A7den son dolu satıra kadar silip veri SAYFASı B C D E satırları combobox1 de ki sayfaya uygun gelecek . Eğer combobox1deki sayfada yazılı veri KONTROL sayfası F2:F aralığında varsa combobox1deki sayfasnin ilgili satırın/ SATIRLARIN komple silinmesi için aşağıdaki kodu yazmaya çalıştım ama olmadı

Daha sonra isimleri rütbeleri yerleştirdikten sonra isimlerin karşına 1 1 1 1 şeklinde 30 sütun 1 yazıp en son 31 sütunda 1 yazanları toplayacak biçim ve formatı ekli dosyada vardi

İlgilenen yok heralde abey akşam birara bakarım.

(18/11/2020, 19:05)feraz yazdı: İlgilenen yok heralde abey akşam birara bakarım.

Size de zahmet olacak Zafer Hocam. Ben uygunum. Eliniz dert görmesin

Hocam aslında kontrol sayfasındaki D E F sütunlarında olan bilgi varsa yani
VERİ sayfasında bulunan personelin sicili Adı soyadı Rütbesini KONTROL sayfasındaki Koşul 1 Koşul 2 veya koşul 3'ten herhangi birine uyması durumunda Ocak Ayı sayfasına almamasını istiyorum. Her ayın B7 hücresinden başlayarak kopyalama işlemi yapılacak
Misal Koşul 1de Grup Amirliği yazıyorsa Ocak ayına VERİ sayfasında bürosu Grup Amirliği diyen hiç kimseyi kopyalamayacak Koşul2 ve 3'de olsun olmasın kopyalama yapılmayacak
Misal rütbesi Teknisyen Yardımcısı yazıyorsa Ocak ayına VERİ sayfasında rütbesi Teknisyen Yardımcısı diyen hiç kimseyi kopyalamayacak Koşul1 ve 3'de olsun olmasın kopyalama yapılmayacak
Misal Sicili 743924 yazıyorsa Ocak ayına VERİ sayfasında sicili 743924 diyen hiç kimseyi kopyalamayacak Koşul1 ve 2'de olsun olmasın kopyalama yapılmayacak

Doğru anladımmı bilemiyorum. Deneyiniz.

Private Sub SayfayýHazýrla_Click()



Dim bul As Range, s1 As Worksheet, s2 As Worksheet, s3 As Worksheet

Dim arr(), i As Long, son As Long, dogru As Boolean, say As Long, soncomboSayfa As Long



If Len(Trim(Me.ComboBox1.Value)) = 0 Then

    MsgBox "Sayfa seciniz...", vbCritical, "Safa sec"

    Exit Sub

End If



Set s1 = ThisWorkbook.Sheets("VERÝ") 'Veri

Set s2 = ThisWorkbook.Sheets("KONTROL") 'Kontrol

Set s3 = ThisWorkbook.Sheets(Me.ComboBox1.Value)

son = s1.Cells(Rows.Count, 1).End(3).Row

soncomboSayfa = s3.Cells(Rows.Count, "Aj").End(3).Row

If soncomboSayfa < 7 Then soncomboSayfa = 7



If son < 2 Then GoTo son

ReDim arr(1 To son, 1 To 5)

say = 1

On Error Resume Next

s3.Range("A7:E" & soncomboSayfa).ClearContents

On Error GoTo 0

For i = 2 To son

    dogru = False

    Set bul = s2.Range("D:F").Find(s1.Cells(i, 2).Value, , , 1) 'Sicil

    If Not bul Is Nothing Then dogru = True

    Set bul = s2.Range("D:F").Find(s1.Cells(i, 3).Value, , , 1) 'ad

    If Not bul Is Nothing Then dogru = True

    Set bul = s2.Range("D:F").Find(s1.Cells(i, 4).Value, , , 1) 'soyad

    If Not bul Is Nothing Then dogru = True

    Set bul = s2.Range("D:F").Find(s1.Cells(i, 5).Value, , , 1) 'rütbe

    If Not bul Is Nothing Then dogru = True

    If dogru = False Then

        arr(say, 1) = say

        arr(say, 2) = s1.Cells(i, 2).Value

        arr(say, 3) = s1.Cells(i, 5).Value

        arr(say, 4) = s1.Cells(i, 3).Value

        arr(say, 5) = s1.Cells(i, 4).Value

        say = say + 1

    End If

Next

If say > 1 Then

    s3.Range("A7").Resize(say, UBound(arr, 2)).Value = arr

End If



son:

Set s1 = Nothing: Set s2 = Nothing: Set s3 = Nothing: Set bul = Nothing: Erase arr

MsgBox "Bitti", vbInformation, "Bitti"

End Sub