Tarihe göre Çoklu Kayıt Bul Aktar

[omeryılmaz]

Merhaba Arkadaşlar...

Kurumumuza ait çalışma da yapılacak işlem ve açıklamalar dosyada mevcut olup, yardım ve önerileriniz için şimdiden şükranlarımı sunuyorum..

 

[Ziynettin]

Merhaba,

Private Sub CommandButton1_Click()
    Dim s1, s2 As Worksheet
    Dim i, son, sat As Integer
        Set s1 = Sheets("ANASAYFA")
        Set s2 = Sheets("SONU")
            s2.Range("A2:J" & Rows.Count).ClearContents
            son = s1.Range("A" & Rows.Count).End(3).Row
            sat = 2
    Application.ScreenUpdating = False
        For i = 2 To son
            If s1.Range("C" & i) >= Sheets("İHLALLER").Range("L1") Then
                s1.Range("A" & i & ":J" & i).Copy
                s2.Range("A" & sat).PasteSpecial (xlPasteValues)
                sat = sat + 1
            End If
        Next i
    Application.ScreenUpdating = True
    s2.Select
MsgBox "Aktarma işlemi tamamlandı", vbInformation, Environ("Username")
End Sub

 

[omeryılmaz]

İLGİNİZ İÇİN TEŞEKKÜRLER
KOD:
Dim S1, s2 As Worksheet
Dim sat1, sat2 As Integer
Set S1 = Sheets("ANASAYFA")
Set s2 = Sheets("İHLALLER")
Set s3 = Sheets("SONU")
s3.Range("A2:J65536").ClearContents
sat = 2
For sat1 = 2 To S1.Cells(65536, "C").End(xlUp).Row
For sat2 = 2 To s2.Cells(65536, "C").End(xlUp).Row
If S1.Cells(sat1, "J") = s2.Cells(sat2, "G") And S1.Cells(sat1, "C") >= s2.Range("L1") Then
s3.Cells(sat, "A") = S1.Cells(sat1, "A")
s3.Cells(sat, "B") = S1.Cells(sat1, "B")
s3.Cells(sat, "C") = S1.Cells(sat1, "C")
s3.Cells(sat, "D") = S1.Cells(sat1, "D")
s3.Cells(sat, "E") = S1.Cells(sat1, "E")
s3.Cells(sat, "F") = S1.Cells(sat1, "F")
s3.Cells(sat, "G") = S1.Cells(sat1, "G")
s3.Cells(sat, "H") = S1.Cells(sat1, "H")
s3.Cells(sat, "I") = S1.Cells(sat1, "I")
s3.Cells(sat, "J") = S1.Cells(sat1, "J")
sat = sat + 1
End If: Next: Next

BÖYLE OLDU