Sayın userx PC başına geçince akşam bakacağım teşekkürler.

aşağıdaki kod bir önce yazdığımdan daha hızlı

Sub CokluStn()



Dim Kynk As Worksheet

Dim Hdf As Worksheet



Dim SonStr As Long, Str As Long

Dim Carp As Integer

Dim StnSay As Integer, Stn As Byte

Dim StrSay As Byte

    

    StnSay = 7 'sütun Sayısı

    StrSay = 50 'satır sayısı

    Carp = StnSay * StrSay



Set Kynk = ThisWorkbook.Worksheets("Veri")

    SonStr = Kynk.Cells(Kynk.Rows.Count, "B").End(xlUp).Row



Set Hdf = ThisWorkbook.Worksheets("Yazdir")

Hdf.UsedRange.Delete



For X = 2 To SonStr Step Carp

y = X

Str = ((X - 1) \ Carp) * StrSay + 2

    For Stn = 2 To StnSay + 1

        Hdf.Cells(Str, Stn).Resize(50) = Kynk.Range("B" & y & ":B" & y + 49).Value

        y = y + StrSay

    Next Stn

Next X

    

SonStr = Hdf.Cells(Hdf.Rows.Count, "B").End(xlUp).Row

Hdf.PageSetup.PrintArea = "$B$2:$H$" & SonStr

Hdf.Range("b2", "h" & SonStr).Borders.LineStyle = xlContinuous



MsgBox "Bitti"

End Sub

Sayın @berduş bey güzel olmuş. Emeğinize sağlık.

---

Sayın @userx öncelikle çok teşekkür ederim. Aktarma çok güzel önizleme çok güzel tek sorun şurada gördüm. Döngüyü önce sağa sonra aşağı şeklinde yapmışsınız. Acaba döngü 1 den aşağıya doğru başlayıp 50 de bitse 2. sütunda 51 den 100 e kadar bitse daha güzel olacak.

06AA001 06AA002 06AA003 06AA004 06AA005 06AA006 06AA007
06AA008 06AA009 06AA010 06AA011 06AA012 06AA013 06AA014
06AA015 06AA016 06AA017 06AA018 06AA019 06AA020 06AA021
06AA022 06AA023 06AA024 06AA025 06AA026 06AA027 06AA028
06AA029 06AA030 06AA031 06AA032 06AA033 06AA034 06AA035
06AA036 06AA037 06AA038 06AA039 06AA040 06AA041 06AA042
.
.
.
.
.
böyle getiriyor. Döngüyü değiştirebilir miyiz?

rica ederim
iyi çalışmalar

Sayın @berduş zaten o şekilde hazırlamış.
Belki başka arkadaşlar benim hazırladığım yönteme ihtiyaç duyabilir. Böyle kalsın.

eğer sayfa önizlemenin sayın @userx 'in örneğindeki gibi görünmesini istiyorsanız
yazdır sayfasındayken görünüm sekmesinden Sayfa Sonu Önizleme seçeneğini seçebilirsiniz