Terfi aktarma işlemleri

[musaagac]

Arkadaşlar ekte göndermiş olduğum çalışmada yapmak istediğim şunlar yardımcı olurmusunuz.

Sayfa1 yer terfi yapılacak kişileri tıkladığımda gelen forma iki tarih gireceğim o tarihleri M6:M1000 kadar olan kişilerde sorgulayıp o tarih aralığındaki kişileri sayfa2 aktarmasını istiyorum yardımcı olurmusunuz.

 

[Orion1]

Dosyanız ektedir.

Private Sub CommandButton2_Click()
Dim i As Long, sat1 As Long, sat2 As Long, sh As Worksheet
Sheets("Sayfa1").Select
Set sh = Sheets("Sayfa2")
sh.Range("A6:O" & Rows.Count).Clear
If Not IsDate(TextBox1.Value) Or Not IsDate(TextBox2.Value) Then
    MsgBox "1. tarih veya 2. tarih yanlış girilimiş!" & vbLf & "İşlem İptal Oldu!", vbCritical, "U Y A R I"
    TextBox1.SetFocus
    Exit Sub
End If
Application.ScreenUpdating = False
sat1 = Cells(Rows.Count, "M").End(xlUp).Row
sat2 = 6
For i = 6 To sat1
     If Cells(i, "M").Value >= CDate(TextBox1.Value) And _
            Cells(i, "M").Value <= CDate(TextBox2.Value) Then
        Range("A" & i & ":O" & i).Copy sh.Range("A" & sat2)
        Application.CutCopyMode = False
        sat2 = sat2 + 1
    End If
Next i
Application.ScreenUpdating = True
sh.Select
Unload Me
MsgBox "İşlem Tamamlanmıştır." & vbLf & "evrengizlen@hotmail.com", _
        vbOKOnly + vbInformation, Application.UserName
Set sh = Nothing

End Sub

 

[Necdet]

Merhaba,

Süzme yöntemi ile seçenek olsun.

Private Sub CommandButton2_Click()
    Dim BsTar As Long
    Dim BtTar As Long
    Dim i     As Long
 
    If IsDate(TextBox1.Value) = False Or IsDate(TextBox2.Value) = False Then
        MsgBox "Tarih Girişleri Hatalı, Düzeltiniz..."
        Exit Sub
    End If
 
    Application.ScreenUpdating = False
    Sheets("Sayfa2").Cells.ClearContents
    BsTar = CDbl(CDate(TextBox1.Value))
    BtTar = CDbl(CDate(TextBox2.Value))
 
    i = Cells(Rows.Count, "A").End(3).Row
    If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter
 
    Range("$A$5:$M$" & i).AutoFilter Field:=13, Criteria1:= _
        ">=" & BsTar, Operator:=xlAnd, Criteria2:="<=" & BtTar
    Range("A4").CurrentRegion.Copy Sheets("Sayfa2").Range("A1")
    Selection.AutoFilter
 
    Application.ScreenUpdating = True
 
End Sub

 

[assenucler]

Sayın Orion1 ve Hamitcan,

Değerli üstadlarım, katkılarınız için teşekkürler.

Sevgi ve saygılar.

 

[Necdet]

Hamitcan arkadaşımız güzel yazmış kodları Bende teşekkür ederim.

 

[musaagac]

Tşk ederim bilgileriniz için. çalışmam ekte şunu istiyorum. sayfa1 bilgileri sayfa2 aktarıyorum ama orada emekli müktesibi, kazanılmış hak aylığını ve kıdem yılını sayfa2 eski yazan yerlere atsın. bu konuda yardımcı olurmusunuz