Bildirim
Excel satırları belli sayılarda bölme
Daha Fazla
Bu Konudaki Kullanıcılar:
Daha Az
2 Misafir - 2 Masaüstü
Giriş
Mesaj
-
-
part derken ayrı sayfalara mı ayrı dosyalara mı? -
Ayrı sheet'e de olur dosyaya da olur hiç fark etmez sadece 100'lü paketlere bölmem gerekiyorquote:
Orijinalden alıntı: akcan
part derken ayrı sayfalara mı ayrı dosyalara mı? -
Aşağıdaki yazdığım VBA makrosu ile 100 er satır olarak yeni eklenen sayfalara aktarılmaktadır.
makroyu kullanmak için
excel dosyan açıkken;
excel durum çubuğundaki sayfa adında sağ tıkla / kod görüntüle
kod alanına aşağıdaki kodları ekle
çalıştırmak için F5 e bas
ya da excel'e geç / ALT+F8 e bas makroyu seç / çalıştır
Sub SatirlariSayfalaraAktar()
'makro: Mesut Akcan
'15 Eylül 2018
For n = 1 To Cells.SpecialCells(xlLastCell).Row Step 100
satirlar = Str(n) & ":" & Trim(Str(n + 99))
Rows(satirlar).EntireRow.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
DoEvents
'Sheets(1).Activate
Next
Sheets(1).Activate
End Sub
-
Hocam çok sağol denedim oldu şimdi ama bu 100lü paketleri farklı excel dosyası olarak kaydedemeyiz değil mi ?quote:
Orijinalden alıntı: akcan
Aşağıdaki yazdığım VBA makrosu ile 100 er satır olarak yeni eklenen sayfalara aktarılmaktadır.
makroyu kullanmak için
excel dosyan açıkken;
excel durum çubuğundaki sayfa adında sağ tıkla / kod görüntüle
kod alanına aşağıdaki kodları ekle
çalıştırmak için F5 e bas
ya da excel'e geç / ALT+F8 e bas makroyu seç / çalıştır
Sub SatirlariSayfalaraAktar()
'makro: Mesut Akcan
'15 Eylül 2018
For n = 1 To Cells.SpecialCells(xlLastCell).Row Step 100
satirlar = Str(n) & ":" & Trim(Str(n + 99))
Rows(satirlar).EntireRow.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
DoEvents
'Sheets(1).Activate
Next
Sheets(1).Activate
End Sub
< Bu mesaj bu kişi tarafından değiştirildi batuhantstkn -- 16 Eylül 2018; 9:7:23 >
-
önceki mesajımda sormuştum sayfalara mı dosyalara mı diye, farketmez deyince sayfalara veren kod yazmıştım.
neyse dosyalara bölen kodu da yazdım. her iki koda da ihtiyacı olan olabilir.
Sub SatirlariDosyalaraAktar()
'makro: Mesut Akcan
'16 Eylül 2018
Klasor = ActiveWorkbook.Path & "\"
For n = 1 To Cells.SpecialCells(xlLastCell).Row Step 100
satirlar = Trim(Str(n)) & ":" & Trim(Str(n + 99))
Rows(satirlar).EntireRow.Copy
Workbooks.Add
ActiveSheet.Paste
Dn = Dn + 1
Dosya = "Dosya_" & Trim(Dn)
ActiveWorkbook.SaveAs Filename:=Klasor & Dosya
ActiveWorkbook.Close
DoEvents
Next
MsgBox "İşlem Tamama"
End Sub -
hocam cidden çok sağol illa benim haricimde de çok kişinin işine yarayacaktır, bu arada imacros üzerinde macro yazabiliyor musun ?quote:
Orijinalden alıntı: akcan
önceki mesajımda sormuştum sayfalara mı dosyalara mı diye, farketmez deyince sayfalara veren kod yazmıştım.
neyse dosyalara bölen kodu da yazdım. her iki koda da ihtiyacı olan olabilir.
Sub SatirlariDosyalaraAktar()
'makro: Mesut Akcan
'16 Eylül 2018
Klasor = ActiveWorkbook.Path & "\"
For n = 1 To Cells.SpecialCells(xlLastCell).Row Step 100
satirlar = Trim(Str(n)) & ":" & Trim(Str(n + 99))
Rows(satirlar).EntireRow.Copy
Workbooks.Add
ActiveSheet.Paste
Dn = Dn + 1
Dosya = "Dosya_" & Trim(Dn)
ActiveWorkbook.SaveAs Filename:=Klasor & Dosya
ActiveWorkbook.Close
DoEvents
Next
MsgBox "İşlem Tamama"
End Sub
-
imacros'u ilk defa duydum. -
Auto clicker için bir eklenti ama hallettim teşekkür ederim :)quote:
Orijinalden alıntı: akcan
imacros'u ilk defa duydum. -
hocam çıktıları .csv olarak kaydetmenin imkanı var mı ?quote:
Orijinalden alıntı: akcan
imacros'u ilk defa duydum. -
ActiveWorkbook.SaveAs Filename:=Klasor & Dosya
satırının sonuna
, FileFormat:=xlCSV
ekleyin.
yani
ActiveWorkbook.SaveAs Filename:=Klasor & Dosya, FileFormat:=xlCSV
< Bu mesaj bu kişi tarafından değiştirildi akcan -- 12 Ekim 2018; 7:15:9 > -
Benim de bu duruma benzer bir ihtiyacım var ben her satırın ayrı ayrı dosyalara bölünmesini istiyorum yani sadece a satırını içeren bir dosya bu örnek galiba 100'er 100'er bölüyor ben makroda 100 olan kısmı bir yaptım ancak bu sefer bir üstündeki satırı silerek ayrı dosya oluşturdu yardım ederseniz çok sevinirim umarım kendimi ifade etmişimdir. -
Kodları biraz geliştirdim.
Satır sayısını başlangıçta kendiniz belirleyebiliyorsunuzSub SatirlariDosyalaraAktar()
'makro: Mesut Akcan
'29 Temmuz 2019
Dim SatirSayisi As Long
Dim Dn 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:"))
If SatirSayisi < 1 Then Exit Sub
Klasor = ActiveWorkbook.Path & "\"
For n = 1 To Cells.SpecialCells(xlLastCell).Row Step SatirSayisi
satirlar = Trim(Str(n)) & ":" & Trim(Str(n + SatirSayisi - 1))
Rows(satirlar).EntireRow.Copy
Workbooks.Add
ActiveSheet.Paste
Dn = Dn + 1
Dosya = "Dosya_" & Format(Dn, "000")
ActiveWorkbook.SaveAs Filename:=Klasor & Dosya
ActiveWorkbook.Close
DoEvents
Next
MsgBox "İşlem Tamam!"
End Sub
Kodda
If SatirSayisi <span><</span> 1 Then Exit Sub
satırı forum tarafından otomatik değiştiriliyor.
Orjinali şu:
If SatirSayisi < 1 Then Exit Sub
ayrıca kodlara https://mesutakcan.blogspot.com/2022/12/excel-satrlarn-belli-sayda-bolme-ve.html
< Bu mesaj bu kişi tarafından değiştirildi akcan -- 26 Haziran 2023; 12:47:11 >
-
elinize sağlık çok işime yaradı ancak son bir talebim olacak eğer yapma imkanınız varsa; toplam 2000 satır var ben 250'şerli olarak ayırmak istiyorum ama bu 250'lik kısımları .txt olarak kaydetmesini istiyorum.quote:
Orijinalden alıntı: akcan
Kodları biraz geliştirdim.
Satır sayısını başlangıçta kendiniz belirleyebiliyorsunuzSub SatirlariDosyalaraAktar()
'makro: Mesut Akcan
'29 Temmuz 2019
Dim SatirSayisi As Long
Dim Dn 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:"))
If SatirSayisi < 1 Then Exit Sub
Klasor = ActiveWorkbook.Path & "\"
For n = 1 To Cells.SpecialCells(xlLastCell).Row Step SatirSayisi
satirlar = Trim(Str(n)) & ":" & Trim(Str(n + SatirSayisi - 1))
Rows(satirlar).EntireRow.Copy
Workbooks.Add
ActiveSheet.Paste
Dn = Dn + 1
Dosya = "Dosya_" & Format(Dn, "000")
ActiveWorkbook.SaveAs Filename:=Klasor & Dosya
ActiveWorkbook.Close
DoEvents
Next
MsgBox "İşlem Tamam!"
End Sub
Kodda
If SatirSayisi <span><</span> 1 Then Exit Sub
satırı forum tarafından otomatik değiştiriliyor.
Orjinali şu:
If SatirSayisi < 1 Then Exit Sub
ayrıca kodlara https://mesutakcan.blogspot.com/2022/12/excel-satrlarn-belli-sayda-bolme-ve.html
-
kodlarda isteğinize uygun değişiklikleri yaptım.
satır sayısını kod çalışınca size soracak zaten 250 de girebilirsin 100 de.Sub SatirlariDosyalaraAktar3()
'makro: Mesut Akcan
'25 Eylül 2019
'txt olarak kaydeder
Dim SatirSayisi As Long
Dim dosyaNo As Integer, n As Integer
Dim klasor As String, satirlar As String, dosyaAdi As String
Dim yeniDosya As Workbook
SatirSayisi = Val(InputBox("Dosyalara bölünecek satır sayısını giriniz:"))
If SatirSayisi < 1 Then Exit Sub
klasor = ActiveWorkbook.Path & "\"
For n = 1 To Cells.SpecialCells(xlLastCell).Row Step SatirSayisi
satirlar = Trim(Str(n)) & ":" & Trim(Str(n + SatirSayisi - 1))
Rows(satirlar).EntireRow.Copy
dosyaNo = dosyaNo + 1
dosyaAdi = "Dosya_" & Format(dosyaNo, "000")
Set yeniDosya = Workbooks.Add
With yeniDosya
.Sheets(1).Paste
.SaveAs Filename:=klasor & dosyaAdi, FileFormat:=xlText
.Close
End With
DoEvents
Next
MsgBox "İşlem Tamam!"
End Sub
Koddaki
If SatirSayisi <span><</span> 1 Then Exit Sub
satırı forum tarafından otomatik değiştiriliyor nedense.
Orjinali şu:
If SatirSayisi < 1 Then Exit Sub
< Bu mesaj bu kişi tarafından değiştirildi akcan -- 25 Eylül 2019; 15:32:56 >
-
çok sağolun. elleriniz dert görmesin.quote:
Orijinalden alıntı: akcan
kodlarda isteğinize uygun değişiklikleri yaptım.
satır sayısını kod çalışınca size soracak zaten 250 de girebilirsin 100 de.Sub SatirlariDosyalaraAktar3()
'makro: Mesut Akcan
'25 Eylül 2019
'txt olarak kaydeder
Dim SatirSayisi As Long
Dim dosyaNo As Integer, n As Integer
Dim klasor As String, satirlar As String, dosyaAdi As String
Dim yeniDosya As Workbook
SatirSayisi = Val(InputBox("Dosyalara bölünecek satır sayısını giriniz:"))
If SatirSayisi < 1 Then Exit Sub
klasor = ActiveWorkbook.Path & "\"
For n = 1 To Cells.SpecialCells(xlLastCell).Row Step SatirSayisi
satirlar = Trim(Str(n)) & ":" & Trim(Str(n + SatirSayisi - 1))
Rows(satirlar).EntireRow.Copy
dosyaNo = dosyaNo + 1
dosyaAdi = "Dosya_" & Format(dosyaNo, "000")
Set yeniDosya = Workbooks.Add
With yeniDosya
.Sheets(1).Paste
.SaveAs Filename:=klasor & dosyaAdi, FileFormat:=xlText
.Close
End With
DoEvents
Next
MsgBox "İşlem Tamam!"
End Sub
Koddaki
If SatirSayisi <span><</span> 1 Then Exit Sub
satırı forum tarafından otomatik değiştiriliyor nedense.
Orjinali şu:
If SatirSayisi < 1 Then Exit Sub
-
twitter üzerinden sorulan bir soru:
Mesut hocam selamlar, bir konuda yardımınıza ihtiyacım var, bir tane excel makronuza ulaştım satırları dosyalara aktar başlığında, çok verili exceli 999 999 dosyalar oluşturduğunuz, benim işime 750 750 lazım kodda ufak değişiklik yapınca oldu zaten, bu benim işimi çok fazlasıyla gördü ama bir ufak daha yardımınız olursa süper olur, ana excelimdeki ilk satırı (yani başlığı) bütün parça parça excellerin ilk satırı olmasını istiyorum, araştırdım ama işin içinden çıkamadı makroya böyle bir kod yazmak mümkün mü yardımlarınızı rica ederim. bir sonraki mesajımda makronuzu göndereceğim.
Sub SatirlariDosyalaraAktar()
'makro: Mesut Akcan
'16 Eylül 2018
Klasor = ActiveWorkbook.Path & "\"
For n = 1 To Cells.SpecialCells(xlLastCell).Row Step 750
satirlar = Trim(Str(n)) & ":" & Trim(Str(n + 749))
Rows(satirlar).EntireRow.Copy
Workbooks.Add
ActiveSheet.Paste
Dn = Dn + 1
Dosya = "Dosya_" & Trim(Dn)
ActiveWorkbook.SaveAs Filename:=Klasor & Dosya
ActiveWorkbook.Close
DoEvents
Next
MsgBox "İşlem Tamama"
End Sub
Ana excelim yaklaşık 200000 veri var totalde 265 dosya yapıyor tek tek kopyala yapıştır yapmaktan daha kısa bir yol varsa yardımınızı rica ederim.
-
Mesut bey merhaba, yazdığınız kodu belirli sayılara göre değil de sütunlar içinde yer alan belirli isimlere göre ayırabilir miyiz? Örneğin, elimdeki veri listesinde X ve Y sütunlarında veri noktaları yer almakta ve her bir serinin başında X ve b
ir isim yer almakta. Her dizinin başında bulunan X satırından bir sonraki X satırına kadar olan kısımları ayrı ayrı kaydedebilir miyiz?
En Beğenilen Yanıtlar
Tüm Yanıtları Genişlet
Aşağıdaki yazdığım VBA makrosu ile 100 er satır olarak yeni eklenen sayfalara aktarılmaktadır.
makroyu kullanmak için excel dosyan açıkken; excel durum çubuğundaki sayfa adında sağ tıkla / kod görüntüle kod alanına aşağıdaki kodları ekle çalıştırmak için F5 e bas ya da excel'e geç / ALT+F8 e bas makroyu seç / çalıştır Sub SatirlariSayfalaraAktar() |
Kodları biraz geliştirdim.
Satır sayısını başlangıçta kendiniz belirleyebiliyorsunuz Sub SatirlariDosyalaraAktar() Kodda If SatirSayisi <span><</span> 1 Then Exit Sub satırı forum tarafından otomatik değiştiriliyor. Orjinali şu: If SatirSayisi < 1 Then Exit Sub ayrıca kodlara https://mesutakcan.blogspot.com/2022/12/excel-satrlarn-belli-sayda-bolme-ve.html |
Benzer içerikler
- pdf.js sürüm 1.0.712 (yapı: 6969ed4) ileti: invalidpdfexception
- excel satır kaydırma
- word sayfa ayırma
- word tek sayfayı yatay yapma
- excel"de iki sütunu karşılaştırıp eşleşen verileri çekme
- office ltsc nedir
- klavye kısayolları
- office 2024
Ip işlemleri
Bu mesaj IP'si ile atılan mesajları ara Bu kullanıcının son IP'si ile atılan mesajları ara Bu mesaj IP'si ile kullanıcı ara Bu kullanıcının son IP'si ile kullanıcı ara
KAPAT X
Bu mesaj IP'si ile atılan mesajları ara Bu kullanıcının son IP'si ile atılan mesajları ara Bu mesaj IP'si ile kullanıcı ara Bu kullanıcının son IP'si ile kullanıcı ara
KAPAT X