Girilen tarihten sonra verilen malzeme listesi

[yolcu50]

Teslim sayfasında L4 hücresine hangi tarihi yazdık ise o tarihten sonra teslim edilen malzemelerin tüm sayfalarda aranıp teslim sayfasına aktarılmasını istiyorum bu mümkün mü acaba şimdiden teşekkür ederim. örnek ektedir.

 

[Orion1]

Dosyanız ektedir.

Sub aktar()
Dim sh As Worksheet, i As Long, sat As Long, sat2 As Long
Sheets("teslim").Select
Range("B3:J65536").Clear
If Not IsDate(Range("L4").Value) Then
    MsgBox "L4 hücresine tarih giriniz.", vbCritical, "UYARI"
    Range("L4").Select
    Exit Sub
End If
sat2 = 3
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> ActiveSheet.Name Then
        sat = sh.Cells(65536, "A").End(xlUp).Row
        For i = 3 To sat
            If sh.Cells(i, "I").Value > Range("L4").Value Then
                sh.Range("A" & i & ":I" & i).Copy Range("B" & sat2)
                sat2 = sat2 + 1
            End If
        Next i
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[yolcu50]

hocam çok teşekkürler sorunumu çok kısa bir süre içerisinde çözdün..

 

[Orion1]

hocam çok teşekkürler sorunumu çok kısa bir süre içerisinde çözdün..

Rica ederim.
İyi çalışmalar.

 

[yolcu50]

hocam bu aktarma işlemlerini tüm sayfalardan değilde verilerin aktarıldığı "teslim" sayfasının sağındaki ilk 7 sayfadan aldırabilirmiyiz. Bu şekilde yapmaz isem başka bir kod ile aldığım verileri tekrar alıyor. mükerrer bir sayım daha yapmış oluyor. o zaman kod da nasıl bir değişiklik yaparız.

 

[Orion1]

hocam bu aktarma işlemlerini tüm sayfalardan değilde verilerin aktarıldığı "teslim" sayfasının sağındaki ilk 7 sayfadan aldırabilirmiyiz. Bu şekilde yapmaz isem başka bir kod ile aldığım verileri tekrar alıyor. mükerrer bir sayım daha yapmış oluyor. o zaman kod da nasıl bir değişiklik yaparız.

Dosyanız ektedir.

Sub aktar()
Dim i As Long, sat As Long, sat2 As Long, j As Integer
Sheets("teslim").Select
Range("B3:J65536").Clear
If Not IsDate(Range("L4").Value) Then
    MsgBox "L4 hücresine tarih giriniz.", vbCritical, "UYARI"
    Range("L4").Select
    Exit Sub
End If
If Worksheets.Count = ActiveSheet.Index Then Exit Sub
sat2 = 3
Application.ScreenUpdating = False
For j = ActiveSheet.Index + 1 To Worksheets.Count
    say = say + 1
    If say <= 7 Then
        sat = Sheets(j).Cells(65536, "A").End(xlUp).Row
        For i = 3 To sat
            If Sheets(j).Cells(i, "I").Value > Range("L4").Value Then
                Sheets(j).Range("A" & i & ":I" & i).Copy Range("B" & sat2)
                sat2 = sat2 + 1
            End If
        Next
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[yolcu50]

teşekkür ederim.

 

[Orion1]

teşekkür ederim.

Rica ederim.