Kitabı 350 şer satır olarak böl ve csv formatında kaydet

[ziya]

Merhaba,
10 binden fazla satırı olan kitabı 350'şer satırlık kitaplar olacak şekilde böl ve yeni oluşan kitapları csv formatında kaydet. Bu işlevi yapacak makroya ihtiyacım var.
Yardımınıza teşekkür ederim.

 

[mustafa1205]

Bi örnekte benden olsun....

 

[ziya]

Teşekkür ederim.
Denedim, gayet güzel çalıştı.
Emeğinize sağlık.

 

[Korhan Ayhan]

Benzer bir konu....

7000 bin satırlı excel dosyamı 120 satırlı dosyalar haline getirebilir miyim?

https://hizliresim.com/AVDxwN Daha önceki kodlarda sadece a1 içerisine virgülle ayırılmış şekilde geliyordu veriler ama, bunu yüklediğim sistem bunu istemiyor sanırım, her birisini ayrı sütunlar halinde istiyor, a1 de olduğu zaman 11 sütun luk veriyi 1 sütun veya 3 sütun olarak algılıyor

www.excel.web.tr

 

[ziya]

Bi örnekte benden olsun....

Sayın Mustafa1205
Excel dosyası olarak değil de, kodları sisteme yazar mısınız.
Teşekkür ederim.

 

[mustafa1205]

Sayın Mustafa1205
Excel dosyası olarak değil de, kodları sisteme yazar mısınız.
Teşekkür ederim.

Tabiki Buyrun


Sub BolVeCSVKaydet_KlasorSec()
Dim ws As Worksheet
Dim satirSayisi As Long
Dim baslangicSatir As Long
Dim bitisSatir As Long
Dim toplamSatir As Long
Dim bolumNo As Long
Dim yeniWB As Workbook
Dim klasorYolu As String
Dim fd As FileDialog
Dim i As Long

' Sayfa adı "DENEME" olmalı
On Error Resume Next
Set ws = ThisWorkbook.Sheets("DENEME")
If ws Is Nothing Then
MsgBox "DENEME adında bir sayfa bulunamadı.", vbCritical
Exit Sub
End If
On Error GoTo 0

' Klasör seçtir
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "CSV dosyalarının kaydedileceği klasörü seçin"
If fd.Show <> -1 Then
MsgBox "Klasör seçilmedi. İşlem iptal edildi.", vbExclamation
Exit Sub
End If
klasorYolu = fd.SelectedItems(1)
If Right(klasorYolu, 1) <> "\" Then klasorYolu = klasorYolu & "\"

' Ayarlar
toplamSatir = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
satirSayisi = 350

Application.ScreenUpdating = False

bolumNo = 1
For baslangicSatir = 2 To toplamSatir Step satirSayisi ' 2’den başla çünkü başlık 1. satır
Set yeniWB = Workbooks.Add
ws.Rows(1).Copy Destination:=yeniWB.Sheets(1).Rows(1) ' Başlık

bitisSatir = baslangicSatir + satirSayisi - 1
If bitisSatir > toplamSatir Then bitisSatir = toplamSatir

ws.Range("A" & baslangicSatir & ":Z" & bitisSatir).Copy _
Destination:=yeniWB.Sheets(1).Range("A2")

' CSV olarak kaydet
yeniWB.SaveAs Filename:=klasorYolu & "Kitap_" & bolumNo & ".csv", FileFormat:=xlCSV
yeniWB.Close SaveChanges:=False

bolumNo = bolumNo + 1
Next baslangicSatir

Application.ScreenUpdating = True

MsgBox "İşlem tamamlandı! CSV dosyaları seçilen klasöre kaydedildi.", vbInformation
End Sub

 

[ziya]

Teşekkür ederim.

 

[mustafa1205]

Teşekkür ederim.

Rica ederim. İyi çlaışmalar dilerim...