Soru Aynı sütundaki verileri yazdir sayfasında A4 sayfasına yazdırma

[yyhy]

Aynı sütundaki verileri yazdir sayfasında A4 sayfasına önce yan yana ve aşağıya doğru macro ile yazdırabilir miyiz?

 

[ÖmerFaruk]

Yazidr sayfanızdaki
A sütununu kaldırdım
1.Boş satırı kaldırdım.
Yazdırma Alanını temizledim
Gerekiyorsa zevkinize uygun olarak sayfa formatını düzenlersiniz.

Sub PlakalarYazdir()
Dim i As Long, Dizi(), YatayDizi()
Dim k As Integer, nRow As Integer, ilkRow As Integer

    Dizi = Sheets("Veri").Range("B2:B" & Sheets("Veri").Range("B" & Rows.Count).End(3).Row).Value
    Sheets("Yazdir").Cells.Clear
    xRow = 1
    For i = 1 To UBound(Dizi) Step 7
        
        For k = 0 To 6
            If i + k > UBound(Dizi) Then Exit For
            ReDim Preserve YatayDizi(k)
            YatayDizi(k) = Dizi(i + k, 1)
        Next
        nRow = nRow + 1
        Sheets("Yazdir").Range(Cells(nRow, 1), Cells(nRow, k)).Value = YatayDizi
        
        If nRow Mod 50 = 0 Or i + k >= UBound(Dizi) Then
            With Range("A" & xRow, "G" & nRow).Borders
                .LineStyle = xlContinuous
                .Color = 0
                .Weight = xlThin
            End With
        xRow = xRow + 50
        End If
    Next i
End Sub

 

[yyhy]

Sayın ÖmerFaruk bey makroyu modul oluşturup ekledim hata verdi. Macro eklediğim dosyaya bakabilir misiniz? Hata nedir acaba?

 

[ÖmerFaruk]

Kodları Veri sayfasından tetiklediğiniz için sorun çıkmış.
Aşağıdaki kodları kullanabilirsin.

Sub PlakalarYazdir()
Dim i As Long, Dizi(), YatayDizi()
Dim k As Integer, nRow As Integer, ilkRow As Integer

    Dizi = Sheets("Veri").Range("B2:B" & Sheets("Veri").Range("B" & Rows.Count).End(3).Row).Value
    Sheets("Yazdir").Cells.Clear
    xRow = 1
    For i = 1 To UBound(Dizi) Step 7
        
        For k = 0 To 6
            If i + k > UBound(Dizi) Then Exit For
            ReDim Preserve YatayDizi(k)
            YatayDizi(k) = Dizi(i + k, 1)
        Next
        nRow = nRow + 1
        Sheets("Yazdir").Range(Sheets("Yazdir").Cells(nRow, 1), Sheets("Yazdir").Cells(nRow, k)).Value = YatayDizi
        
        If nRow Mod 50 = 0 Or i + k >= UBound(Dizi) Then
            With Sheets("Yazdir").Range("A" & xRow, "G" & nRow).Borders
                .LineStyle = xlContinuous
                .Color = 0
                .Weight = xlThin
            End With
        xRow = xRow + 50
        End If
    Next i
End Sub

 

[yyhy]

Sayın ÖmerFaruk bey teşekkür ederim. İhtiyaca cevap verdi. Emeğinize sağlık.