dolu hücreleri aktarmak

[lansor]

öncelikle sitenin yeni uygulamasının hayırlı olmasını diliyor emeği geçenlere teşşekkür ediyorum.
sorum şu ekteki dosyamda açıkladığım üzere dolu olan hücreleri ve değerlerini tablo sayfasına aktarıp dizecek.fonksiyon yada makro farketmez ilgilenen hocalarıma ve emeği geçeceklere şimdiden teşekkür ederim.

 

[muygun]

Slm.
Ekteki tabloyu inceleyin. Gereken açıklamaları tablo üzerinde belirttim.
İyi çalışmalar.

 

[Ömer]

Merhaba,

Sorunuzu Sayın muygun yanıtlamış, alternatif olması açısından ekteki dosyayı inceleyebilirsiniz..

Dosyada kullanılan bazı formüller Sayın Ali'nin çalışmasından alıntıdır..


.

 

[S.Yiğit]

Sy muygun Sy espiyonajl tşkler tabi Sy Ali hocamızada..

 

[lansor]

Sayın muygun ve sayın espiyonajl çok çok teşekkür ederim emeğinize sağlık. Sizlere ne kadar teşekkür etsek azdır.sağolunuz.sonsuz selamlar

 

[lansor]

espiyonajl hocam: gönderdiğiniz dosya çok güzel ama gene takıldım tablo sayfasında 140 dan sonra yazmıyor #yok hatası veriyor sana zahmet tekrar bakarmısın selamlar

 

[Ömer]

espiyonajl hocam: gönderdiğiniz dosya çok güzel ama gene takıldım tablo sayfasında 140 dan sonra yazmıyor #yok hatası veriyor sana zahmet tekrar bakarmısın selamlar

Formül aralıklarında son değeri 140 olarak tanımlamıştım, formüllerdeki 140 değerini arttırırsanız sorun çözülür ( 140 yerine 300 gibi ) eğer olmaz ise tablo aralıklarınız boyutunu söylerseniz (tablodaki satır sayısını) yardımcı olmaya çalışırım..

 

[lansor]

espiyonajl hocam 140 sayısını 150 yaptım.8 tane si #yok hatası veriyor.
güncel sayfası AO141 dahil AO150 ye kadar olan hücrelerde #Yok hatası var dolayısıylada tablo sayfasındada da a140:d149 aralığında da #yok gözüküyor

saat gece 3 oldu ben hala hatayı bulamadım
güncel adlı tablomdaki satır sayım 146 sıra no ile 150 nci satırda bitti
AK141 AL141 AM141 AN141 AO141
179 130 28 116 #YOK
141 131 27 109 #YOK
114 132 27 110 #YOK
727 133 29 120 #YOK
278 134 27 111 #YOK
479 135 28 117 #YOK
696 135 29 121 #YOK
583 136 27 112 #YOK
761 137 27 113 #YOK
1002 138 29 122 #YOK
AO141 :=EĞER(AM141="";"";İNDİS(AM:AM;KAÇINCI(SATIRSAY($AO$5:AO141);AN:AN;0);1))

 

[Ömer]

3. mesajımdaki dosyayı aralıkları genişleterek yeniden ekledim, 3.mesajımdaki dosyayı tekrar incelermisiniz..

.

 

[Orion1]

Makro ile çözüm
Dosyanız ekte.

Sub aktar()
Dim hcr As Range, i As Byte, sut As Byte, sat As Long, var As Balloon
sat = 4
Sheets("GÜNCEL").Select
Application.ScreenUpdating = False
Sheets("Tablo").Range("A4:D65536").ClearContents
For Each hcr In Range("A4:A200")
    For i = 4 To 43
        If hcr.Offset(0, i).Value <> "" Then
            Sheets("Tablo").Cells(sat, "A").Value = Cells(3, i + 1).Value
            Sheets("Tablo").Cells(sat, "B").Value = hcr.Value
            Sheets("Tablo").Cells(sat, "C").Value = hcr.Offset(0, 1).Value
            Sheets("Tablo").Cells(sat, "D").Value = hcr.Offset(0, i).Value
            sat = sat + 1
        End If
    Next i
Next hcr
Sheets("Tablo").Range("A4:D200").Sort key1:=Sheets("Tablo").Range("A4"), _
key2:=Sheets("Tablo").Range("B4"), key3:=Sheets("Tablo").Range("C4")
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır..!!", vbOKOnly + vbInformation, "İŞLEM TAMAM"
End Sub

 

[lansor]

sayın evren 1245 sayısını atmamış makronuzu çalıştırıp bir kontrol ediniz.sanırım 2 isim olunca birini atıyor 2 taneçırpan olacak bir tanesini atmış2563 olanı atmış diğeri yok.belki başka birilerine yarar düzeltirseniz. sayın espiyonajl fonksiyon kullanmış şu an onla çalışıyorum ama makro daha kolay düzeltirseniz altarnatif olarak hepimize yarar ilginiz için tekrar tşk ediyorum herkese kolay gelsin

 

[Orion1]

Tamam ben eksik görmüşüm.

 

[Orion1]

sayın evren 1245 sayısını atmamış makronuzu çalıştırıp bir kontrol ediniz.sanırım 2 isim olunca birini atıyor 2 taneçırpan olacak bir tanesini atmış2563 olanı atmış diğeri yok.belki başka birilerine yarar düzeltirseniz. sayın espiyonajl fonksiyon kullanmış şu an onla çalışıyorum ama makro daha kolay düzeltirseniz altarnatif olarak hepimize yarar ilginiz için tekrar tşk ediyorum herkese kolay gelsin

Dosyayı düzenledim.
10 numaralı mesajdan indirebilirsiniz.