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

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
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.

C++:
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
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Kodları Veri sayfasından tetiklediğiniz için sorun çıkmış.
Aşağıdaki kodları kullanabilirsin.
C++:
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

Altın Üye
Katılım
3 Aralık 2005
Mesajlar
917
Excel Vers. ve Dili
Microsoft Office 2021 TR
Microsoft 365 TR
Altın Üyelik Bitiş Tarihi
20-03-2029
Sayın ÖmerFaruk bey teşekkür ederim. İhtiyaca cevap verdi. Emeğinize sağlık.
 
Üst