Verileri Yukarı Taşıma

[baydeniro]

Merhaba arkadaşlar. Ekteki dosyada DATA sayfasında A1:C251 arasında veriler mevcuttur. Bu verileri 50 satırlık dilimler halinde yukarı ilk boş kolondaki 2. satıra taşıyan bir makro mümkün müdür ?

Not : 1. satır soldan sağa doğru kopyalanacak.

 

[mrttrn]

Sayıın serdarokan kendimce bulduğum çözüm bu.Sadece başlıkları kopyalama
eksik.İnşallah işini görür.
İlgili çalışma ilişikte.

Private Sub CommandButton1_Click()
 Set DT = Worksheets("DATA")
 Set DTP = Worksheets("DATA1")
 Dim i, sf
 Dim st 'sutun sayısı için
 sf = WorksheetFunction.CountA(DT.Range("A:A")) / 50 'A sutunundaki elemanları say. 50 e böl. Kaç tane 50 var.Tespiti için
 
 '2.satırdaki  daki eleman sayısı=sutun sayısı
 'A2ile 50. sutunun 2. satırı arası
 st = WorksheetFunction.CountA(DT.Range(Cells(2, 1), Cells(2, 50)))
 
 'sanki excel sayfasında ki gibi işlem yapıyoruz.İlK 1.-55.satır kopyalanıyor.
 DT.Select
 DT.Range(Cells(1, 1), Cells(51, st)).Select 'seç.
 DT.Range(Cells(1, 1), Cells(51, st)).Copy
 DTP.Select
 DTP.Range("A1").PasteSpecial Paste:=xlValues  'değerleri yapıştır
 DTP.Columns.AutoFit 'sutunları değerlere göre genişlet.
 
 If sf > 1 Then  'birden fazla sayfa varsa.
  For i = 1 To Int(sf) 'Int tam kısımı bulan fonk. Ör: Int(2,59)=2
    DT.Select
    DT.Range(Cells(50 * i + 2, 1), Cells(50 * i + 50 + 1, st)).Select
    DT.Range(Cells(50 * i + 2, 1), Cells(50 * i + 50 + 1, st)).Copy
    DTP.Select
    DTP.Cells(2, st * i + 1).PasteSpecial Paste:=xlValues  'değerleri yapıştır
    DTP.Columns.AutoFit 'sutunları değerlere göre genişlet.
  Next
 End If
End Sub

 

[mrttrn]

Sayın serdarokan bir önceki konudan yeni haberim oldu. Bir sayfa içinde 4 veya 6 sayfa sığdırıp.Çıktısını 1 sayfa olarak almak;Fontun genişliğine, büyüklüğüne,satır ve sutun genişliğine dayalı olarak kanımca değişmektedir.
Bunu en güzel ustalarımız çözer.Ben daha yeni üye oldum.Hasbel kader yardımcı olmaya çalışıyorum.

 

[baydeniro]

Çok Teşekkürler

Sayın mrttrn çok çok teşekkürler. Bu tam istediğim gibi olmuş. Ellerinize sağlık. Bir sorum olacak. Commandbutton düğmesini Macro düğmesi ile değiştirebilir miyim ?

 

[mrttrn]

module1 de sub düzeltme() makrosu yarattım.

excel deki DÜZELT düğmesinde;
Düğmeyi sağ tıklayıp düzeltme seçtim.oldu.

Düğme li dosya ilişiktedir.