Yalnız Mesajı Göster
Eski 03-01-2018, 20:13  
sinan05
 
Giriş: 16/11/2017
Şehir: istanbul
Mesaj: 76
Excel Vers. ve Dili:
Excel 2016 Türkçe
Varsayılan Koşula göre başka sayfadan veriler getirme

Hocalarım merhabalar, herkese hayırlı akşamlar. Bir konuda daha yardımınıza ihtiyacım var. Makro tam oldu diyorum çalışmama göre başka hatalar çıkıyor. Sorunum şu aşağıda yazmış olduğum kodlar müşteriler klosörüne gidip ordaki çalışma kitablarındaki ve her sayfasındaki G24:P24 arasındaki verileri getiriyor. G24 hücresinde tarih var. Ben buraya bir koşul eklemek istiyorum. Eğer G24 hücresindeki tarih içinde bulunduğumuz aydan küçükse belirtilen vrileri getirsin. içinde bulunduğumuz bir aya ait ise getirmesin. Yardımlarınız için şimdiden teşekkür ederim.

Sub Bakiyeler()
Application.ScreenUpdating = False
Dim evn As Object, klasoradi As String, kitap As Workbook
Dim i As Integer, x As Integer, dosyam As Workbook
Set kitap = ThisWorkbook
kitap.Sheets("BAKİYELER").Range("a2:J65536").Clear Contents
klasoradi = "Müşteriler"
Set evn = CreateObject("scripting.filesystemobject")
Set dosyalar = evn.getfolder(ThisWorkbook.Path & Application.PathSeparator & klasoradi)
For Each klasor In dosyalar.Files
Set dosyam = GetObject(klasor.Path)
For i = 1 To dosyam.Sheets.Count
For x = 24 To 24
If dosyam.Sheets(i).Cells(x, "g").Value <> "" Then
xtarih = dosyam.Sheets(i).Cells(x, "g").Value
dosyam.Sheets(i).Range("g" & x & "p" & x).Copy
kitap.Sheets("BAKİYELER").Range("a65536").End(3)(2 , 1).PasteSpecial xlPasteValues
End If
Next x
Next i
dosyam.Close False
Next klasor
ActiveWindow.SmallScroll Down:=-6
Range("B2:K501").Select
ActiveWindow.ScrollRow = 478
ActiveWindow.ScrollRow = 467
ActiveWindow.ScrollRow = 445
ActiveWindow.ScrollRow = 370
ActiveWindow.ScrollRow = 271
ActiveWindow.ScrollRow = 191
ActiveWindow.ScrollRow = 175
ActiveWindow.ScrollRow = 124
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 1
ActiveWorkbook.Worksheets("BAKİYELER").Sort.SortFi elds.Clear
ActiveWorkbook.Worksheets("BAKİYELER").Sort.SortFi elds.Add Key:=Range("B2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("BAKİYELER").Sort
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
End With
Range("M5").Select
Set evn = Nothing: Set kitap = Nothing: Set dosyam = Nothing
Application.ScreenUpdating = True
End Sub
sinan05 Çevrimdışı   Alıntı Yaparak Cevapla