Soru Sadece son 1 ay içindeki değerleri kopyalamak

[seckinb]

Merhabalar

worksheets("Tutulum Paterni") içerisinde 1 aydan eski veriler mevcut. kopyalama işleminde eski verilerin gelmesi değerler verimi karıştırıyor.

Diğer veriler için statik bir kopyalama kodu hazırladım. bu kısmı güzelce çalışıyor.

Sub dis_veri_al()
  
    Dim TW As Workbook, dv As Workbook, TS As Worksheet, ds As Worksheet
  
    Dim FSO As Object, FD As FileDialog, filename As String
      
    Set FSO = CreateObject("Scripting.FileSystemObject")


    Set TW = ThisWorkbook
    Set TS = TW.Worksheets("kimlik")
      
    mainFolder = FSO.getFile(ThisWorkbook.FullName).parentFolder.parentFolder.parentFolder.Path & "\LU177_TATE"

    Set FD = Application.FileDialog(msoFileDialogFilePicker)

    With FD
        .Title = "Seçim yapın..."
        .AllowMultiSelect = False
        .InitialFileName = mainFolder
        .Filters.Add "Excel dosyaları", "*.xlsx; *.xlsm; *.xls; *.xlm", 1
        If .Show = True Then
      filename = Dir(.SelectedItems(1))
        ElseIf .Show <> -1 Then Exit Sub
        End If
      
    End With

Call islemiptal
  
    Workbooks.Open (filename)
    Set dv = Workbooks(filename)
    Set ds = dv.Worksheets("kimlik")
  
    dv.Activate
    'veri alınacak dosya seçiliyor.
  
    For Each Sh In Worksheets
        Sh.Unprotect "sb123"
    Next
    'koruma kaldırılıyor.
  
    ActiveSheet.Cells.UnMerge
    'geçici unmerge yapılıyor.
  
dv.Worksheets("Konsey_ekibi").Range("A2:I100").Copy
TW.Worksheets("Konsey_ekibi").Cells(2, 1).PasteSpecial Paste:=xlPasteValues
  
ds.Cells(1, 3).Copy
TS.Cells(1, 3).PasteSpecial Paste:=xlPasteValues

ds.Cells(2, 3).Copy
TS.Cells(2, 3).PasteSpecial Paste:=xlPasteValues

ds.Cells(3, 3).Copy
TS.Cells(3, 3).PasteSpecial Paste:=xlPasteValues

ds.Cells(5, 3).Copy
TS.Cells(5, 3).PasteSpecial Paste:=xlPasteValues
  
ds.Cells(1, 8).Copy
TS.Cells(1, 8).PasteSpecial Paste:=xlPasteValues

ds.Cells(2, 8).Copy
TS.Cells(2, 8).PasteSpecial Paste:=xlPasteValues

ds.Cells(3, 8).Copy
TS.Cells(3, 8).PasteSpecial Paste:=xlPasteValues


'HİKAYE
ds.Range("B19:B23").Copy
TS.Range("B19:B23").PasteSpecial Paste:=xlPasteValues

ds.Range("B28:B32").Copy
TS.Range("B28:B32").PasteSpecial Paste:=xlPasteValues

ds.Range("d19:d23").Copy
TS.Range("e19:e23").PasteSpecial Paste:=xlPasteValues

ds.Range("d28:d32").Copy
TS.Range("e28:e32").PasteSpecial Paste:=xlPasteValues

'PATOLOJİ
ds.Cells(39, 1).Copy
TS.Cells(39, 1).PasteSpecial Paste:=xlPasteValues

'ÖYKÜ
TW.Worksheets("kimlik").oyku1.Value = dv.Worksheets("kimlik").oyku.Value

Application.CutCopyMode = False

dv.Close savechanges:=False
  
TW.Worksheets("Formlar").Select

Call islemnormal
  
End Sub


Sub islemiptal()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
End Sub


Sub islemnormal()
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

koşullu olarak 1 ay içindeki veriyi, şeklinde ama sadece son 1 aydakiler olacak şekilde kopyalamak istiyorum.

dv.Worksheets("Görüntülemeler").Range("A2:C30").Copy
TW.Worksheets("Tutulum Paterni").Cells(2, 1).PasteSpecial Paste:=xlPasteValues

bu koşulunu nasıl oluşturabilirim?
dv.Worksheets("Görüntülemeler") - A sütununda tarih verisi bulunmakta.

 

[Recep İpek]

Sanırım sorunuza gelişmiş filtre yöntemi ile çözüm bulunabilir.

Excel'de Gelişmiş Filtre ile verileri başka bir çalışma sayfasına nasıl kopyalarım?

www.extendoffice.com