Belli sayıda veriyi sayfalara bölme

[doktorteknik]

Değerli Arkadaşlar Merhaba,

Excel dosyamın bir sayfasında 50.000 satır veri mevcut. Bu verileri 2500'er adet olarak "çalışma sayfalarına" bölmek istiyorum. Makro olarak bunu nasıl yapabilirim ?

Forumda "Belli sayıda veriyi sayfalara bölme" olarak aradım ama sonuca ulaşamadım. Belki de daha önce yapılmıştır.

Yardımlarınızı rica eder,
İyi çalışmalar dilerim.

 

[halit3]

Değerli Arkadaşlar Merhaba,

Excel dosyamın bir sayfasında 50.000 satır veri mevcut. Bu verileri 2500'er adet olarak "çalışma sayfalarına" bölmek istiyorum. Makro olarak bunu nasıl yapabilirim ?

Forumda "Belli sayıda veriyi sayfalara bölme" olarak aradım ama sonuca ulaşamadım. Belki de daha önce yapılmıştır.

Yardımlarınızı rica eder,
İyi çalışmalar dilerim.

Örnek dosya ekleseydiniz daha iyi olurdu.

Option Explicit
Sub sayfalara_ayir()
Dim git, sat, sut, sat1, sat2, i, bölünecek_sayi, sh
git = ActiveSheet.Name
Set sh = Sheets("VERİ")
If WorksheetFunction.CountA(sh.Cells) > 0 Then
sat = sh.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sut = sh.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Else
Exit Sub
End If
bölünecek_sayi = 250
sat1 = bölünecek_sayi
sat2 = 0
For i = 1 To sat
Sheets.Add
Sheets(ActiveSheet.Name).Move After:=Sheets(ActiveWorkbook.Sheets.Count)
Worksheets("VERİ").Range(Worksheets("VERİ").Cells(sat2 + 1, 1), Worksheets("VERİ").Cells(sat1 + sat2, sut)).Copy
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
sat2 = sat2 + sat1
i = i + sat1
Next i
Sheets(git).Select
End Sub
Sub sayfalari_sil()
Dim git, i, r
If ActiveWorkbook.Sheets.Count >= 2 Then
git = ActiveSheet.Name
Dim myArray() As Variant
r = 0
For i = 1 To Sheets.Count
If Sheets(i).Name = "VERİ" Then
r = r + 1
Else
ReDim Preserve myArray(i - (1 + r))
myArray(i - (1 + r)) = i
End If
Next i
Sheets(myArray).Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets(git).Select
End If
End Sub

 

[hamitcan]

Farkli Bir Çözüm;

Sub SayfalaraBol()
    ToplamKayitSayisi = 12
    SayfaKayitSayisi = 3
    AcilacakSayfa = ToplamKayitSayisi / SayfaKayitSayisi
    For i = 1 To AcilacakSayfa
        Sheets.Add
        ActiveSheet.Name = "Data" & i
    Next
    c = 2
    t = 2 + SayfaKayitSayisi
    For i = 1 To AcilacakSayfa
        d = d + 1
        Sheets("ToplamKayitlar").Rows(c & ":" & t).Copy Sheets("Data" & d).[a2]
        c = t + 1
        t = SayfaKayitSayisi + t + 1
    Next
End Sub

 

[berkerturk]

Arkadaşlar acil yardıma ihtiyacım var...elimde 3000 kişilik bir liste var bu listeyi kişilerin şubelerine göre her şubedeki kişilerin ayrı bir kitapta olacağı şekilde bölmek istiyorum...

 

[ysmnbkn]

merhabalar ,
txt uzantılı bir dosyam vardı tüm içinde 394 tane program kodu mevcut
bu dosyayı excelde actım tek sütunda eklendi.
programlar sonu "M99" veya "M30" ile bitiyor
bu program kodlarını ayrı txt dosyalarına ayırmaya çalışıyorum.
nasıl yapabilirim.
makro veya excelde bi yöntem varmıdır acaba ?

 

[adoen]

Merhabalar,

Benimde elimde aşağıdaki tablodaki gibi bir excel var, istediğim sıra numarasına göre yeni sayfalar açılması ve başlıkla birlikte ilgili satırdaki kayıtların açılan yeni sayfaya kopyalanması.
Şimdiden teşekkür edrim.

sıra no	ad soyad	tüketim
1	ali	10
2	veli	20
3	adnan	30
4	emrah	40

Örnek:


sayfa 1 deki veri

sıra no	ad soyad	tüketim
1	ali	10

sayfa 2 deki veri

sıra no	ad soyad	tüketim
2	veli	20