3'lü Kolon Kod Yerleşimi

[akasay]

Arkadaşlar merhaba şuradaki resimdeki gibi bir yazdırma sayfam var 7 X 3 = 21 li karelerden oluşuyor her bir karede 5 satırım var.. Her bir karenin 1. satırına 1-2-3-4-5-6-7-8-9-... yazdığımda (veriler başka bi sayfan çekiliyor) 21 den sonraki 22. kareye bir satır boşluk atlayıp yazıyor. Kodlarım:

Private Sub Worksheet_Activate()
Sheets("ETİKET YAZDIR").Unprotect "akasay"
Dim i   As Long, _
        Sat As Long, _
        j  As Integer, _
        Kol As Integer, _
        Grp As Integer
    Dim tum, yaz As Worksheet
    Sheets("TÜMÜ").Unprotect "akasay"
Set tum = Sheets("TÜMÜ")
Set yaz = Sheets("ETİKET YAZDIR")
yaz.Cells.ClearContents
son = tum.Range("E13").End(xlDown).Row

    Application.ScreenUpdating = False
    
 tum.Range("E13:E" & son).SpecialCells(xlCellTypeVisible).Copy yaz.Range("CA1")
 tum.Range("H13:H" & son).SpecialCells(xlCellTypeVisible).Copy yaz.Range("CB1")
 tum.Range("I13:I" & son).SpecialCells(xlCellTypeVisible).Copy yaz.Range("CC1")
 tum.Range("J13:J" & son).SpecialCells(xlCellTypeVisible).Copy yaz.Range("CD1")
 tum.Range("K13:K" & son).SpecialCells(xlCellTypeVisible).Copy yaz.Range("CE1")
    
     
   
    Grp = 1
    Sat = 1
    j = 0
    Kol = 1
    
    For i2 = 1 To Cells(Rows.Count, "CA").End(3).Row
  
    
        yaz.Cells(Sat, Kol) = yaz.Cells(i2, "CA")
        yaz.Cells(Sat + 1, Kol) = yaz.Cells(i2, "CB")
        yaz.Cells(Sat + 2, Kol) = yaz.Cells(i2, "CC")
        yaz.Cells(Sat + 3, Kol) = yaz.Cells(i2, "CD")
        yaz.Cells(Sat + 4, Kol) = yaz.Cells(i2, "CE")
         
   Sat = Sat + 5
        j = j + 1
        If j > 6 Then
            j = 0
            Sat = (Grp - 1) * 18 + 1
            Kol = Kol + 1
            If Kol = 1 Then Kol = Kol + 1
            If Kol > 3 Then
                Kol = 1
                Grp = Grp + 2
                Sat = (Grp - 1) * 18 + 1
            End If
        End If
     
    Next i2
   
    Sheets("ETİKET YAZDIR").Protect "akasay"
    
End Sub

Kodları nasıl düzenlemem gerek acaba?

 

[Necdet]

Merhaba,

Olayın özü etiket ise xl de neden uğraşıp duruyorsunuz ki? Word de adres mektup birleştirmeyi öğreniniz. Her türlü etiketi kullanma olanağınız olur.
Microsoft'un sayfasında anlatılıyor.