Tarihe göre veri çekme kodu

pasha22

Altın Üye
Altın Üye
Katılım
27 Ocak 2012
Mesajlar
57
Beğeniler
1
Excel Vers. ve Dili
2016 Türkçe
#1
Merhabalar,
Tarihe göre veri çektiğim dosyada "şablon" sayfasında ilgili yere tarih girince, "tüm grup kodları" sayfasında bulunan her kişiye ait kodları "sıralama" sayfasındaki sıraya göre şablon sayfasına çekmektedir.
Ancak verileri çekerken "tüm grup kodları" sayfasındaki kodların karşısındaki isimleri 4 lü olarak çekmektedir.
Ben oradaki verileri 4' lü sıraya bağlı kalmadan karışık yazınca aynı sayfaya nasıl çekebilirim.

Örnek: D1, D2, D3, D4 ya da D5, D6, D7, D8 birer ekip olduğu için sıralı ekip geliyor ancak ben "sıralama" sayfasında bazen ekiplerin içinde değişiklik yaparak D1,D3,D7,D8 gibi karışık olarak 4' lü yazınca error veriyor.

Bunu nasıl yapabilirim.
Kodlar aşağıda, örnek dosya ektedir.

Saygılarımla.

Kod:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim S1 As Worksheet, STR As Long, STN As Long, S2 As Worksheet
Dim STR1 As Range, DRS As Range, SBT As Variant
Application.ScreenUpdating = False
Application.EnableEvents = False
If Intersect(Target, Range("H1")) Is Nothing Then _
Application.EnableEvents = True: Application.ScreenUpdating = True: _
Exit Sub
Range("B7:I10").Clear: Range("B13:I16").Clear
Range("B19:I22").Clear: Range("B25:I28").Clear
Range("B31:I34").Clear: Range("B37:I40").Clear
SBT = ActiveCell.Address
Set S1 = Sheets("SIRALAMA"): Set S2 = Sheets("TÜM GRUP KODLARI")
With WorksheetFunction
STR = .Match(Range("H1"), S1.Range("A:A"), 0)
End With
For STN = 2 To S1.Cells(STR, Columns.Count).End(xlToLeft).Column Step 4
If S1.Cells(STR, STN) <> Empty Then
Set DRS = Range("B:Y").Find(S1.Cells(1, STN), , , xlWhole)
Set STR1 = S2.Range("A:J").Find(S1.Cells(STR, STN), , , xlWhole)
S2.Range(S2.Cells(STR1.Row, STR1.Column + 1).Address & ":" & S2.Cells(STR1.Row + 3, STR1.Column + 2).Address).Copy
Range(Cells(DRS.Row + 1, DRS.Column).Address).PasteSpecial
Application.CutCopyMode = False
End If
Next
Range(SBT).Select
Application.EnableEvents = True: Application.ScreenUpdating = True
End Sub
 

Ekli dosyalar

pasha22

Altın Üye
Altın Üye
Katılım
27 Ocak 2012
Mesajlar
57
Beğeniler
1
Excel Vers. ve Dili
2016 Türkçe
#2
Merhabalar,
bu konuya tekrar ihtiyacım oldu, yardımcı olabilecek varmı?
saygılarımla.
 

cems

Altın Üye
Katılım
2 Eylül 2005
Mesajlar
2,020
Beğeniler
41
Excel Vers. ve Dili
office 2003 tr + office 2010 tr 32bit
#3
...
 

pasha22

Altın Üye
Altın Üye
Katılım
27 Ocak 2012
Mesajlar
57
Beğeniler
1
Excel Vers. ve Dili
2016 Türkçe
#5
...
 
Üst