Hücre Doluysa Makro İle Kopyalamak

[Kekoli]

Merhaba,

Belirli bir parametreye göre değer alan ve büyükten küçüğe sıralanan bir tablom var,
Filtreyi 2018 seçtiğimde
A 50
B 40
C 30
D 10
E 0
oluyor,
Filtreyi 2019 Seçtiğimde

E 50
C 40
A 30
B 0
D 0

oluyor,

ben bunları grafik haline getiriyorum. doğal olarak "0" olan satırlar ve rakamların solundaki tanımlar da 0 olarak ya da "-" olarak grafikte seri etiketi olarak gözüküyor,
öyle bir şey yapmalıyım ki ,

makro kod, ilgili alanı tarayıp, değer varsa tabloyu aynı sayfada başka yere yapıştırmalı, ama değer yoksa içi boş gelmeli. (formül ile yaptım, ama formülü de değer olarak gördüğünden boş seri etiketi ve boş değer gösteriyor grafik)

yardımlarınızı bekliyorum.

 

[Korhan Ayhan]

Örnek dosyanız olmadığı için farazi aktarım kodu hazırladım.

Aşağıdaki kod "A" sütunundaki "1-100" satırları arasında filtrelenmiş satırları döngüye alarak sıfırdan farklı değerleri "C" sütununa alt alta aktarır.

Kendi tablonuza göre uyarlamasını yaparsınız.

Sub Aktar()
    Dim X As Long, Satır As Long
    
    Range("C:C").ClearContents
    Satır = 1
    
    For X = 1 To 100
        If Cells(X, 1).RowHeight > 0 Then
            If Cells(X, 1) <> 0 Then
                Cells(Satır, 3) = Cells(X, 1)
                Satır = Satır + 1
            End If
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Kekoli]

örnek dosya ektedir

 

[Kekoli]

Örnek dosyanız olmadığı için farazi aktarım kodu hazırladım.

Aşağıdaki kod "A" sütunundaki "1-100" satırları arasında filtrelenmiş satırları döngüye alarak sıfırdan farklı değerleri "C" sütununa alt alta aktarır.

Kendi tablonuza göre uyarlamasını yaparsınız.

Sub Aktar()
    Dim X As Long, Satır As Long
   
    Range("C:C").ClearContents
    Satır = 1
   
    For X = 1 To 100
        If Cells(X, 1).RowHeight > 0 Then
            If Cells(X, 1) <> 0 Then
                Cells(Satır, 3) = Cells(X, 1)
                Satır = Satır + 1
            End If
        End If
    Next
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

bunu kendi koduma uyarladım, süper oldu, olağanüstüünüz tşk.