Formülle veri çoğaltma ve aktarma

[Hardrada]

merhabalar.
şöyle bir sorunum var: a sütununda 6-8 haneli seri numaraları, karşılarındaki satırlarda, mesela c1 hücresinden bb1 hücresine kadar a1 hücresindeki numaranın alternatif seri numaraları bulunuyor.
yapmak istediğim şey; a1 deki numarayı almak, c1'den bb1'e kadar hücrelerin sadece dolu olanlarını saydırıp a1'deki numarayı dolu hücre sayısınca alt alta yazdırmak ve c1'den bb1'e kadar olan numaraları bu alt alta yazılan aynı numaraların karşısına yani b sütununa aktarmak. başka, temiz bir sayfada olsa daha iyi olur bu işlem.
a2 için aynı işlemin tekrarlanması gerekiyor tabiki.
yardım edebilen olursa teşekkürler şimdiden.

 

[Milady Meriç]

Selam dostum,,

aşağıdaki kod HESAP sayfasında bulunan verileri SONUC isimli sayfa toplar.
Ekte dosyayı gönderiyorum, kendine göre uyarlayabilirsin.

Public Sub TOPARLA()
Dim milady As Range
Dim meric As Long


For Each milady In Worksheets("HESAP").Range("C1:BB17")
  If milady.Value <> "" Then
  meric = Worksheets("SONUC").Cells(Rows.Count, "B").End(xlUp).Row
  y = milady.Row
  Worksheets("SONUC").Cells(meric + 1, 2).Value = milady.Value
  Worksheets("SONUC").Cells(meric + 1, 1).Value = Worksheets("HESAP").Cells(y, 1).Value
  End If
Next

End Sub

 

[Hardrada]

Selam dostum,,

aşağıdaki kod HESAP sayfasında bulunan verileri SONUC isimli sayfa toplar.
Ekte dosyayı gönderiyorum, kendine göre uyarlayabilirsin.

Public Sub TOPARLA()
Dim milady As Range
Dim meric As Long


For Each milady In Worksheets("HESAP").Range("C1:BB17")
  If milady.Value <> "" Then
  meric = Worksheets("SONUC").Cells(Rows.Count, "B").End(xlUp).Row
  y = milady.Row
  Worksheets("SONUC").Cells(meric + 1, 2).Value = milady.Value
  Worksheets("SONUC").Cells(meric + 1, 1).Value = Worksheets("HESAP").Cells(y, 1).Value
  End If
Next

End Sub

çok teşekkürler dostum, çok net bir şekilde çözüldü sorun