Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 03-01-2018, 20:13   #1
sinan05
 
Giriş: 16/11/2017
Şehir: istanbul
Mesaj: 72
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
Eski 03-01-2018, 20:45   #2
sinan05
 
Giriş: 16/11/2017
Şehir: istanbul
Mesaj: 72
Excel Vers. ve Dili:
Excel 2016 Türkçe
Varsayılan

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").Clear Contents
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 & "" & 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.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
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 06:00


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Rampa- Rotary- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Çorlu Sürücü Kursu- Şişli Avukat- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kaplan Tekstil- Çorlu Perde- Çorlu Havuz- Makina- Danışmazlar-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden