DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Aktar()
On Error Resume Next
Application.ScreenUpdating = False
Set S1 = Sheets("ÜretimVeri")
Set S2 = Sheets("günlük rapor")
Set alan1 = S1.Range("B5:AB2500")
Set alan2 = S2.Range("B2:B3")
Set alan3 = S2.Range("B4:AB2500")
alan3.ClearContents
alan1.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=alan2, CopyToRange:=alan3, Unique:=False
Application.ScreenUpdating = True
End Sub