Formatı koruyarak listeleme [VBA]

[kucukon]

Merhaba üstadlar,

Ekte paylaştığım dosyanın RaporSayfa sekmesinde makro ile, ilk sekmedeki verileri çeken bir rapor fonksiyonu yazmaya çalışıyorum.

Kişi ismi ve hedef kodu kayan listeden seçildikten sonra, gizli satırlarda bir tarama yapıyorum. Bu taramanın sonucuna göre asıl ilgilendiğim kodları elde ediyorum (Gizli hücrelerde: D2:F157 adresinde). Sonra bu kodları ilk sayfadaki ilgili kolonla karşılaştırıp (HedefTakip: B2:B345 adresinde), gerekli karşılıkları getirmeye çalıştım.

Aslında ağır aksak çalışan bir makro yazdım fakat referans olan hücrenin formatını, raporda gözüken hücreye kopyalamayı beceremedim. Tabi buna ek olarak da yazdığım makro çok hantal ve 10-15sn hesap yapıyor.

Size kolay bana zor bu görevde yardımlarınızı rica ediyorum.
Şimdiden teşekkür ederim.

 

[turist]

Sayın kucukon
Eklemiş olduğunuz dosyada Makro Kodlarınız yer almıyor.
Eğer, makro kodlarınızın olduğu dosyanızı eklerseniz, gerekli düzeltme ve/veya iyileştirmeler daha kolay ve hızlı yapılabilir.

 

[kucukon]

Sayın kucukon
Eklemiş olduğunuz dosyada Makro Kodlarınız yer almıyor.
Eğer, makro kodlarınızın olduğu dosyanızı eklerseniz, gerekli düzeltme ve/veya iyileştirmeler daha kolay ve hızlı yapılabilir.

Merhaba Sn. turist.
Eklediğim dosyada, MaktoListesi sekmesinde yazdığım makro kodunu görebilirsiniz.

Konusu açılmışken şunu da sorayım; makroyu kaydediyorum ve LİSTELE butonuna atıyorum, fakat dosyayı her kapatıp açışımda LİSTELE butonu altına atadığım makro kayboluyor. Ben bundan kurtulmak için tüm yazıyı bir sonraki taba kopyalamıştım, her kapatıp açışımda oradan alarak tekrar yapıştıryorum. Bu neden oluyor?

Bir de son derece amatör bir kod olduğ için çalışması çok uzun sürüyor, bu noktada da desteğinize ihtiyacım var.

Şimdiden teşekkür ederim.

 

[kucukon]

Yazdığım kod aşağıdaki gibidir.


Sub Listele()
Dim i As Integer
Dim k As Integer
Dim j As Integer

Worksheets("RaporSayfa").Range("K189:K220").ClearContents

k = 188

For i = 2 To 157
If Cells(i, "E") = Cells(i, "F") Then k = k + 1
If Cells(i, "E") = Cells(i, "F") Then Cells(k, "K") = Cells(i, "E")
Next

k = 189
Do While k < 221
For j = 2 To 1000
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "L") = Worksheets("HedefTakip").Cells(j, "P")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "N") = Worksheets("HedefTakip").Cells(j, "R")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "P") = Worksheets("HedefTakip").Cells(j, "U")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "Q") = Worksheets("HedefTakip").Cells(j, "V")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "R") = Worksheets("HedefTakip").Cells(j, "W")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "S") = Worksheets("HedefTakip").Cells(j, "X")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "T") = Worksheets("HedefTakip").Cells(j, "Y")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "U") = Worksheets("HedefTakip").Cells(j, "Z")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "V") = Worksheets("HedefTakip").Cells(j, "AA")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "W") = Worksheets("HedefTakip").Cells(j, "AB")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "X") = Worksheets("HedefTakip").Cells(j, "AC")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "Y") = Worksheets("HedefTakip").Cells(j, "AD")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "Z") = Worksheets("HedefTakip").Cells(j, "AE")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "AA") = Worksheets("HedefTakip").Cells(j, "AF")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "AB") = Worksheets("HedefTakip").Cells(j, "AG")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "AC") = Worksheets("HedefTakip").Cells(j, "AH")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "AD") = Worksheets("HedefTakip").Cells(j, "AI")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "AE") = Worksheets("HedefTakip").Cells(j, "AJ")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "AF") = Worksheets("HedefTakip").Cells(j, "AK")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "AG") = Worksheets("HedefTakip").Cells(j, "AL")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "AH") = Worksheets("HedefTakip").Cells(j, "AM")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "AI") = Worksheets("HedefTakip").Cells(j, "AN")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "AJ") = Worksheets("HedefTakip").Cells(j, "AO")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "AK") = Worksheets("HedefTakip").Cells(j, "AP")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "AL") = Worksheets("HedefTakip").Cells(j, "AQ")
If Cells(k, "K") = Worksheets("HedefTakip").Cells(j, "B") Then Worksheets("RaporSayfa").Cells(k, "AM") = Worksheets("HedefTakip").Cells(j, "AR")
Next


k = k + 1
Loop

End Sub