boş hücre yerine dolu hücre değeri gelsin

[asilme]

arkadaşlar kolay gelsin.Benim sormak istediğim gün içerisinde yaklaşık 30 sütuna farklı zamanlarda hücre değeri giriyorum.akşam olunca hücreleri sıralamam gerekiyor.kimi sütuna 50 satır kimi sütuna 5 satır değer girmiş oluyorum.benim istediğim istediğim zaman bu çalıştığım 30 sütundaki değerleri otomatik olarak dağıtmak ve hepsini aynı hizaya getirmek örneğin 312 tane ayrı değer girdik a sütununda 5 b sütununda 15 c de 35 satır değer var bunu sıralattığımda ( 30 sütun olarak ) toplamda 11 satır tam dolup 12. satıra 2 hücre dolu oluyor.bunu nasıl yapabilirim bilgisi olan varmı şimdiden sağolun

 

[dellerlim]

Örnek dosya yükleyebilir misiniz?

 

[asilme]

dosya

http://s5.dosya.tc/server4/yob8hn/arsiv_dosya_takip_1.rar.html

dosyayı buraya yükledim şimdiden teşekkürler.

 

[asilme]

http://s5.dosya.tc/server4/yob8hn/arsiv_dosya_takip_1.rar.html

dosyayı buraya yükledim şimdiden teşekkürler.

arkadaşlar soru ile ilgili olarak fikri olan var mı acaba lütfen destek olur musunuz bu mümkün değilmi benim için çok önemli yardımcı olursanız çok sevinirim şimdiden teşekkürler hakkınızı helal edin

 

[YUSUF44]

Tam olarak istediğiniz gibi oldu mu bilmiyorum ancak aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub Makro1()
son = Cells(Rows.Count, "A").End(3).Row
Cells(Rows.Count, "A").End(3).Select
baş = ActiveCell.End(3).Row + 2
dolu = WorksheetFunction.CountA(Range("A" & baş & ":T" & Rows.Count))
10:
fazla = dolu Mod 20
    For i = 1 To 20
        satır = WorksheetFunction.RoundUp(dolu / 20, 0)
        If i > fazla Then satır = satır - 1
        eski = Cells(Rows.Count, i).End(3).Row
        If eski > baş + satır - 1 Then
            For j = 1 To 20
                If Cells(Rows.Count, j).End(3).Row < baş + satır - 1 Then
                    yeni = Cells(Rows.Count, j).End(3).Row + 1
                    Range(Cells(baş + satır, i), Cells(eski, i)).Cut Cells(yeni, j)
                    j = 20
                    GoTo 10
                End If
            Next
        End If
    Next
End Sub

 

[asilme]

Tam olarak istediğiniz gibi oldu mu bilmiyorum ancak aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub Makro1()
son = Cells(Rows.Count, "A").End(3).Row
Cells(Rows.Count, "A").End(3).Select
baş = ActiveCell.End(3).Row + 2
dolu = WorksheetFunction.CountA(Range("A" & baş & ":T" & Rows.Count))
10:
fazla = dolu Mod 20
    For i = 1 To 20
        satır = WorksheetFunction.RoundUp(dolu / 20, 0)
        If i > fazla Then satır = satır - 1
        eski = Cells(Rows.Count, i).End(3).Row
        If eski > baş + satır - 1 Then
            For j = 1 To 20
                If Cells(Rows.Count, j).End(3).Row < baş + satır - 1 Then
                    yeni = Cells(Rows.Count, j).End(3).Row + 1
                    Range(Cells(baş + satır, i), Cells(eski, i)).Cut Cells(yeni, j)
                    j = 20
                    GoTo 10
                End If
            Next
        End If
    Next
End Sub

hocam elinize sağlık kısmen olmuş sadece alt alta birkaç tablo olduğunda istediğim tabloyu yapmak için ne yapmalıyım.şuan en altakini yapıyor,seçip sıralatma nasıl olur acaba ancak hakkınızı helal edin bu kadarı bile benim için büyük kolaylık
teşekkürler

 

[YUSUF44]

Önceki makrodaki bir hatayı aşağıdaki haliyle düzelttim. Önceki hali bazı sütunları eksik ya da fazla bırakıyordu:

Sub Makro1()
son = Cells(Rows.Count, "A").End(3).Row
Cells(Rows.Count, "A").End(3).Select
baş = ActiveCell.End(3).Row + 2
dolu = WorksheetFunction.CountA(Range("A" & baş & ":T" & Rows.Count))
10:
fazla = dolu Mod 20
    For i = 1 To 20
        satırA = WorksheetFunction.RoundUp(dolu / 20, 0)
        If i > fazla Then satırA = satırA - 1
        eski = Cells(Rows.Count, i).End(3).Row
        If eski > baş + satırA - 1 Then
            For j = 1 To 20
                satır = WorksheetFunction.RoundUp(dolu / 20, 0)
                If j > fazla Then satır = satır - 1
                If Cells(Rows.Count, j).End(3).Row < baş + satır - 1 Then
                    yeni = Cells(Rows.Count, j).End(3).Row + 1
                    Range(Cells(baş + satır, i), Cells(eski, i)).Cut Cells(yeni, j)
                    j = 20
                    GoTo 10
                End If
            Next
        End If
    Next
End Sub

Son isteğinize yani birden fazla tablo için çalışmasına gelince, önceki mesajınızda her gün için işlem yapacağınızı belirttiğinizden en son tablo için ayar yaptım. İsteğiniz muhtemelen yapılabilir ancak beni aşıyor, bunun mantığını oturtmakta bile çok zorlandım maalesef.

Geçici bir çözüm olarak düzeltilmiş kısmı üst kısma alarak önceki tablonun altta kalmasını sağlayabilir ve makroyu tekrar çalıştırabilirsiniz.

 

[asilme]

Yusuf hocam çok teşekkür ederim hakkınızı helal edin