Excel satırları belli sayılarda bölme (2. sayfa)

Aşağıdaki makroyu kullanınız.

Sub SatirlariDosyalaraAktar4()

'makro: Mesut Akcan

'mesutakcan.blogspot.com

'29 Kasım 2020

Dim yenidosya As Workbook

Application.ScreenUpdating = False

xSutunu = "A" 'X olan sütun adı

klasor = ActiveWorkbook.Path & "\"

SonDoluSatir = Range(xSutunu & Rows.Count).End(xlUp).Row

For satir = 1 To SonDoluSatir

hucre = xSutunu & Trim(Str(satir))

If Range(hucre).Value = "X" Or satir = SonDoluSatir Then

  If basla = 0 Then

    basla = satir + 1

  Else

    bitis = IIf(satir = SonDoluSatir, SonDoluSatir, satir - 1)

    Range(Trim(Str(basla)) & ":" & Trim(Str(bitis))).EntireRow.Copy

    dosyaAdi = Range(xSutunu & basla - 1).Offset(0, 1).Value

    Set yenidosya = Workbooks.Add

    With yenidosya

      .Sheets(1).Paste

      .SaveAs Filename:=klasor & dosyaAdi

      .Close

    End With

    basla = satir + 1

  End If

End If

DoEvents

Next

Application.ScreenUpdating = True

MsgBox "İşlem Tamam!"

End Sub

merhaba kod harika çalışıyor elinize sağlık. Ancak bir küçük ekleme rica etsem parçalara böldüğü veride header kısmı sadece 1. parçada çıkıyor malesef.

Plaka Şehir Nüfus

34 İstanbul 17m

35 İzmir 4,3m

gibi bir datada her excel dosyasının başında Plaka Şehir Nüfus headeri eklense şahane olacak.

İsteğinize göre kodları değiştirdim. Umarım işinizi görür.

'Excel sayfasındaki verileri istenilen satır sayısı kadar dosyalara böler

'Başlık satırı varsa bölünen dosyalara başlık ekleme özelliği eklendi.

Sub SatirlariDosyalaraAktar2_v2()

'makro: Mesut Akcan

'19 Şubat 2021

'mesutakcan.blogspot.com

Dim SatirSayisi As Long

Dim dosyaNo As Integer, n As Integer

Dim klasor As String, satirlar As String, Dosya As String

SatirSayisi = Val(InputBox("Dosyalara bölünecek satır sayısını giriniz:", , 100))

If SatirSayisi < 1 Then

  MsgBox "Satır sayısı 1 veya daha büyük olmalı"

  Exit Sub

End If

awbp = ActiveWorkbook.Path 'aktif dosya kayıt klasörü

klasor = InputBox("Dosyaların kaydedileceği klasör:", , awbp)

If Right(klasor, 1) <> "\" Then klasor = klasor & "\"

bsvar = MsgBox("Başlık satırı var mı?", vbYesNo)

If bsvar = vbYes Then bs = 2 'başlık satırı varsa başlama satırı 2

For n = bs To Cells.SpecialCells(xlLastCell).Row Step SatirSayisi

  satirlar = Trim(Str(n)) & ":" & Trim(Str(n + SatirSayisi - 1))

  If bsvar Then satirlar = "1:1," & satirlar

  Range(satirlar).Copy

  Workbooks.Add

  ActiveSheet.Paste

  dosyaNo = dosyaNo + 1

  Dosya = "Dosya_" & Format(dosyaNo, "000")

  ActiveWorkbook.SaveAs Filename:=klasor & Dosya ', FileFormat:=xlText

  ActiveWorkbook.Close

  DoEvents

Next

MsgBox "İşlem Tamam!"

End Sub

Kodları şurada da görebilirsiniz:

mesutakcan.blogspot.com

Excel satırlarını belli sayıda bölme ve dosya veya sayfalara aktarma

https://mesutakcan.blogspot.com/2022/12/excel-satrlarn-belli-sayda-bolme-ve.html

harikasınız beni çok büyük bir dertten kurtardınız. ellerinize sağlık tekrardan çok teşekkür ederim.

Tüm kodları blog sayfama ekledim.

mesutakcan.blogspot.com

Excel satırlarını belli sayıda bölme ve dosya veya sayfalara aktarma

https://mesutakcan.blogspot.com/2022/12/excel-satrlarn-belli-sayda-bolme-ve.html

Merhaba hocam, öncelikli verdiğiniz bilgiler için çok teşekkür ederim yaptığımız işte çok işime yaradı. Bu (üst satırları da tutarak veya ekleyerek) bölümlediğimiz dosyaları tekrar birleştirmek için bir makro kodunuz var mıdır? örnek veriyorum 10 adet bölünmüş excel de 9 sutun başlıklı ve binlerce satırlık veriler var elimde bunu birleştirebilir miyiz? aslında birleştirmeyi tek excel de kopyala yapıştır ile de uzun uzadıya yapabilirim ancak örnek veriyorum tc ad soyad doğum tarihi doğum yeri gibi sutunlardan bazıları eksik olduğunda tc yi tc ye ad ı ad a boş bile olsa denk getirerek birliştirebilen bi formül olabilir mi diye size danışmak istedim.

merhaba

Kod 
Yığını:
129000 satırlı bir excel dosyam var. bunları 9000 satır şeklinde bölmek istiyorum. sizin makronuzu kullandım ancak (For n = 1 To Cells.SpecialCells(xlLastCell).Row Step SatirSayisi) stırı hata veriyor "overflow) hatası

129000 satırlı kimlik numaralı içeren bir excel dosyam var. bunu 9000 satır olarak bölmek istiyorum. sizin makroyu kullandığımda overflow hatası veriyor

Dim dosyaNo As Integer, n As Integer

Satırını

Dim dosyaNo As Integer, n As Long

olarak değiştirip deneyin.

Mesut Bey, bu komutu başlıkları ile ayırma şeklinde revize eder misiniz, her yerde aradım bu tarzda kod paylaşmamışsınız bulamadım.

Sub SatirlariDosyalaraAktar_v8()

kodlarını uygulayın. Çalıştırıldığında "Başlık satırı var mı?" diye soracak.

kodlar bu sayfada

mesutakcan.blogspot.com

Excel satırlarını belli sayıda bölme ve dosya veya sayfalara aktarma

https://mesutakcan.blogspot.com/2022/12/excel-satrlarn-belli-sayda-bolme-ve.html