• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Koşula göre başka sayfadan veriler getirme

  • Konbuyu başlatan Konbuyu başlatan sinan05
  • Başlangıç tarihi Başlangıç tarihi
S

sinan05

Katılım
16 Kasım 2017
Mesajlar
255
Excel Vers. ve Dili
office professional plus 2021
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").ClearContents
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.SortFields.Clear
ActiveWorkbook.Worksheets("BAKİYELER").Sort.SortFields.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
 
Hocalarım hallettim teşekkürler. Aşağıdaki kodları ekledim oldu. belki ihtiyacı olan olur diye tamamını ekliyorum herkese hayırlı akşamlar.
Sub Bakiyeler()
Application.ScreenUpdating = False
Dim tarih1 As Date, tarih2 As Date, xtarih As Date
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").ClearContents
tarih1 = kitap.Sheets("Sayfa1").Range("m1").Value
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
If xtarih < tarih1 Then
dosyam.Sheets(i).Range("g" & x & ":p" & x).Copy
kitap.Sheets("BAKİYELER").Range("a65536").End(3)(2, 1).PasteSpecial xlPasteValues
End If
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.SortFields.Clear
ActiveWorkbook.Worksheets("BAKİYELER").Sort.SortFields.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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst