[Yardım]  Sayfalara bölme hakkında..

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Sayfalara bölme hakkında..

İleti#1)  mertakpolat » 12 Eyl 2019 00:12

Herkese iyi geceler öncelikle, Günlük olarak çıkardığım raporlar ekteki şekilde. Bunları tek tek sayfalara ayırmak için epey uğraşıyorum. Her hat no tek sayfa olarak ayarlanacak. Bu konuda yardımcı olabilirseniz çok sevinirim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
mertakpolat
 
Kayıt: 12 Eyl 2019 00:08
Meslek: bilgi işlem
Yaş: 40
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul / Beyoğlu

Cevap: Sayfalara bölme hakkında..

İleti#2)  Ali ÖZ » 13 Eyl 2019 16:20

Merhaba,
Her excel dosyasını kendi içinde sayfalara ayırmak mıdır yapmak istediğiniz ?
Allah bize yeter, O ne güzel vekildir.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Kullanıcı avatarı
Ali ÖZ
Forum Moderatörü
 
Adı Soyadı:Ali ÖZ
Kayıt: 17 Oca 2013 10:16
Konum: SAKARYA
Meslek: Yazılım
Yaş: 38
İleti: 10068
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adapazarı/SAKARYA

Cevap: Cevap: Sayfalara bölme hakkında..

İleti#3)  mertakpolat » 13 Eyl 2019 20:37

Ali ÖZ yazdı:Merhaba,
Her excel dosyasını kendi içinde sayfalara ayırmak mıdır yapmak istediğiniz ?


Evet, örn. Bağlarçeşme güzergah raporu kendi içinde sayfa sayfa olucak. her hat numarası için ayrı sayfa. Günlük çıktı alıyorum çünkü. bu şekilde 11 adet rapor var,
Kullanıcı avatarı
mertakpolat
 
Kayıt: 12 Eyl 2019 00:08
Meslek: bilgi işlem
Yaş: 40
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul / Beyoğlu

Cevap: Sayfalara bölme hakkında..

İleti#4)  mertakpolat » 15 Eyl 2019 09:56

Yardımcı olabilecek var mı arkadaşlar, benim için epey önemli çünkü.
Kullanıcı avatarı
mertakpolat
 
Kayıt: 12 Eyl 2019 00:08
Meslek: bilgi işlem
Yaş: 40
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul / Beyoğlu

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Sayfalara bölme hakkında..

İleti#5)  mertakpolat » 22 Ekm 2019 21:24

Arkadaşlar sorun çözülememiştir. Yardımcı olabilecek birisi var mı acaba.
Kullanıcı avatarı
mertakpolat
 
Kayıt: 12 Eyl 2019 00:08
Meslek: bilgi işlem
Yaş: 40
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul / Beyoğlu

Cevap: Sayfalara bölme hakkında..

İleti#6)  erseldemirel2 » 23 Ekm 2019 00:56

Dosyaya indirdim bir bakıyorum
www.erseldemirel.com.tr
Kullanıcı avatarı
erseldemirel2
Site Dostu
 
Kayıt: 31 Oca 2019 12:51
Meslek: Mühendis
Yaş: 35
İleti: 618
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çankaya

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Cevap: Sayfalara bölme hakkında..

İleti#7)  erseldemirel2 » 23 Ekm 2019 00:58

mertakpolat yazdı:Arkadaşlar sorun çözülememiştir. Yardımcı olabilecek birisi var mı acaba.



Ekledim. Kontrol edin
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
www.erseldemirel.com.tr
Kullanıcı avatarı
erseldemirel2
Site Dostu
 
Kayıt: 31 Oca 2019 12:51
Meslek: Mühendis
Yaş: 35
İleti: 618
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çankaya

Cevap: Sayfalara bölme hakkında..

İleti#8)  erseldemirel2 » 23 Ekm 2019 08:38

Aşağıdaki kodu özetleyeyim. İçerisinde "Küçükçekmece : 00" geçen satırların numaralarını tespit ediyoruz. İkisi arasındaki satır toplam farkını tespit etmek için ayrı bir sayfaya yazdım. Sonra bu tespit sayfasını hersatıra gelecek şekilde aradaki boşlukları sildim. Sırada tespitte adı geçen satır sayısı kadar sayfa eklemek var. Sayfalar eklendi. Sonra hersayfaya "Hat1" sayfasındaki veriler solbaştan başlamak üzere üzerlerine yazıldı. Sonuç olarak "hat1" sayfanı 31 sayfaya parçaladık.


Kod: Tümünü seç
Sub hesapla()
Dim ht1 As Worksheet: Set ht1 = Sheets("HAT1")
Dim tsp As Worksheet: Set tsp = Sheets("TESPİT")
Application.ScreenUpdating = False
sonsatirht1 = ht1.Range("A65536").End(3).Row
sonsatirtsp = tsp.Range("A65536").End(3).Row
tsp.Range("A1:A" & sonsatirtsp + 1).ClearContents
For i = 1 To sonsatirht1
If ht1.Range("A" & i) = "Küçükçekmece : 00" Then
tsp.Range("A" & i) = i
End If
Next i
tsp.Range("A" & sonsatirht1 + 3) = sonsatirht1 + 3
tsp.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For j = 1 To sonsatirtsp - 1
ThisWorkbook.Sheets.Add
Sheets(ActiveSheet.Name).Name = sonsatirtsp - j
Next j
For t = 1 To sonsatirtsp - 1
Sheets(t).Select
ht1.Range(("A" & tsp.Range("A" & t)), ("J" & tsp.Range("A" & t + 1) - 2)).Copy Sheets(t).Range("A1")
Next t
Application.ScreenUpdating = True
End Sub
www.erseldemirel.com.tr
Kullanıcı avatarı
erseldemirel2
Site Dostu
 
Kayıt: 31 Oca 2019 12:51
Meslek: Mühendis
Yaş: 35
İleti: 618
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çankaya

Cevap: Cevap: Sayfalara bölme hakkında..

İleti#9)  mertakpolat » 23 Ekm 2019 11:09

erseldemirel2 yazdı:Aşağıdaki kodu özetleyeyim. İçerisinde "Küçükçekmece : 00" geçen satırların numaralarını tespit ediyoruz. İkisi arasındaki satır toplam farkını tespit etmek için ayrı bir sayfaya yazdım. Sonra bu tespit sayfasını hersatıra gelecek şekilde aradaki boşlukları sildim. Sırada tespitte adı geçen satır sayısı kadar sayfa eklemek var. Sayfalar eklendi. Sonra hersayfaya "Hat1" sayfasındaki veriler solbaştan başlamak üzere üzerlerine yazıldı. Sonuç olarak "hat1" sayfanı 31 sayfaya parçaladık.


Kod: Tümünü seç
Sub hesapla()
Dim ht1 As Worksheet: Set ht1 = Sheets("HAT1")
Dim tsp As Worksheet: Set tsp = Sheets("TESPİT")
Application.ScreenUpdating = False
sonsatirht1 = ht1.Range("A65536").End(3).Row
sonsatirtsp = tsp.Range("A65536").End(3).Row
tsp.Range("A1:A" & sonsatirtsp + 1).ClearContents
For i = 1 To sonsatirht1
If ht1.Range("A" & i) = "Küçükçekmece : 00" Then
tsp.Range("A" & i) = i
End If
Next i
tsp.Range("A" & sonsatirht1 + 3) = sonsatirht1 + 3
tsp.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For j = 1 To sonsatirtsp - 1
ThisWorkbook.Sheets.Add
Sheets(ActiveSheet.Name).Name = sonsatirtsp - j
Next j
For t = 1 To sonsatirtsp - 1
Sheets(t).Select
ht1.Range(("A" & tsp.Range("A" & t)), ("J" & tsp.Range("A" & t + 1) - 2)).Copy Sheets(t).Range("A1")
Next t
Application.ScreenUpdating = True
End Sub



Yardımınız için çok teşekkür ederim, Ben istediğimi tam olarak anlatamadığımdan dolayı olmadı. Kusura bakmayın.

İlk mesajda attığım raporu ben her gün, düzenleyip çıktı alıyorum. Yani tüm hat no'lar tek excel sayfası üstünde olması gerekiyor tek seferde yazıcıdan daha kolay çıkartmam için. Bu şekilde 11 adet rapor var 30 sayfa, 18 sayfa, 21 sayfa vs. diye değişiyor. ,

Yani benim tam olarak istediğim; gönderdiğim excel dosyasını tek sayfa üzerinden sayfa sonu sekmelerini ekleyip, 31 sayfayı yazıcıya göndermeye hazır hale getirmek. Size de zahmet verdim kusura bakmayın tekrar.
Kullanıcı avatarı
mertakpolat
 
Kayıt: 12 Eyl 2019 00:08
Meslek: bilgi işlem
Yaş: 40
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul / Beyoğlu

Cevap: Cevap: Sayfalara bölme hakkında..

İleti#10)  mertakpolat » 23 Ekm 2019 11:16

erseldemirel2 yazdı:Aşağıdaki kodu özetleyeyim. İçerisinde "Küçükçekmece : 00" geçen satırların numaralarını tespit ediyoruz. İkisi arasındaki satır toplam farkını tespit etmek için ayrı bir sayfaya yazdım. Sonra bu tespit sayfasını hersatıra gelecek şekilde aradaki boşlukları sildim. Sırada tespitte adı geçen satır sayısı kadar sayfa eklemek var. Sayfalar eklendi. Sonra hersayfaya "Hat1" sayfasındaki veriler solbaştan başlamak üzere üzerlerine yazıldı. Sonuç olarak "hat1" sayfanı 31 sayfaya parçaladık.


Kod: Tümünü seç
Sub hesapla()
Dim ht1 As Worksheet: Set ht1 = Sheets("HAT1")
Dim tsp As Worksheet: Set tsp = Sheets("TESPİT")
Application.ScreenUpdating = False
sonsatirht1 = ht1.Range("A65536").End(3).Row
sonsatirtsp = tsp.Range("A65536").End(3).Row
tsp.Range("A1:A" & sonsatirtsp + 1).ClearContents
For i = 1 To sonsatirht1
If ht1.Range("A" & i) = "Küçükçekmece : 00" Then
tsp.Range("A" & i) = i
End If
Next i
tsp.Range("A" & sonsatirht1 + 3) = sonsatirht1 + 3
tsp.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For j = 1 To sonsatirtsp - 1
ThisWorkbook.Sheets.Add
Sheets(ActiveSheet.Name).Name = sonsatirtsp - j
Next j
For t = 1 To sonsatirtsp - 1
Sheets(t).Select
ht1.Range(("A" & tsp.Range("A" & t)), ("J" & tsp.Range("A" & t + 1) - 2)).Copy Sheets(t).Range("A1")
Next t
Application.ScreenUpdating = True
End Sub


Ben raporları ekteki şekle getirip arşivleyip çıktı alıyorum hergün. Günlük toplam 218 sayfa olarak.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
mertakpolat
 
Kayıt: 12 Eyl 2019 00:08
Meslek: bilgi işlem
Yaş: 40
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul / Beyoğlu

Cevap: Sayfalara bölme hakkında..

İleti#11)  erseldemirel2 » 23 Ekm 2019 12:45

Hazır sayfalara bölünmüşken hersayfanın çıktısını ayarlıyor.Kodlar kısaltılabilir



Kod: Tümünü seç
Sub hesapla()
Dim ht1 As Worksheet: Set ht1 = Sheets("HAT1")
Dim tsp As Worksheet: Set tsp = Sheets("TESPİT")
Dim syf As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each syf In ThisWorkbook.Worksheets
If syf.Name <> "HAT1" And syf.Name <> "TESPİT" Then
syf.Delete
End If
Next syf
sonsatirht1 = ht1.Range("A65536").End(3).Row
sonsatirtsp = tsp.Range("A65536").End(3).Row
tsp.Range("A1:A" & sonsatirtsp + 1).ClearContents
For i = 1 To sonsatirht1
If ht1.Range("A" & i) = "Küçükçekmece : 00" Then
tsp.Range("A" & i) = i
End If
Next i
tsp.Range("A" & sonsatirht1 + 3) = sonsatirht1 + 3
tsp.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For j = 1 To sonsatirtsp - 1
ThisWorkbook.Sheets.Add
Sheets(ActiveSheet.Name).Name = sonsatirtsp - j
Next j
For t = 1 To sonsatirtsp - 1
Sheets(t).Select
ht1.Range(("A" & tsp.Range("A" & t)), ("J" & tsp.Range("A" & t + 1) - 2)).Copy Sheets(t).Range("A1")
Sheets(t).Columns("a").ColumnWidth = 20
Sheets(t).Columns("b").ColumnWidth = 20
Sheets(t).Columns("c").ColumnWidth = 20
Sheets(t).Columns("d").ColumnWidth = 20
Sheets(t).Columns("e").ColumnWidth = 20
Sheets(t).Columns("f").ColumnWidth = 20
Sheets(t).Columns("g").ColumnWidth = 20
Sheets(t).Columns("h").ColumnWidth = 20
Sheets(t).Columns("i").ColumnWidth = 20
Sheets(t).Columns("j").ColumnWidth = 20
ActiveWindow.Zoom = 80
ActiveWindow.View = xlPageBreakPreview
sat = Sheets(t).Range("A65536").End(3).Row
Sheets(t).PageSetup.PrintArea = "$A$1:$J" & sat + 1
With Sheets(t).PageSetup
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Next t
For ws = 1 To ThisWorkbook.Sheets.Count
If Sheets(ws).Name <> "HAT1" And Sheets(ws).Name <> "TESPİT" Then Sheets(ws).Select Replace:=False
Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
www.erseldemirel.com.tr
Kullanıcı avatarı
erseldemirel2
Site Dostu
 
Kayıt: 31 Oca 2019 12:51
Meslek: Mühendis
Yaş: 35
İleti: 618
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çankaya


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Yandex[Bot] ve 1 misafir

cron
Bumerang - Yazarkafe