Benden bu kadar
Sub ListeAktarDz()
Dim SonStr As Long
Dim Sht As Worksheet
Dim ShtHdf As Worksheet
Dim Dizi() As Variant
Dim DiziKynk() As Variant
Const sutun As Byte = 12
Set Sht = ThisWorkbook.Worksheets("ANA LÝSTE")
Set ShtHdf = ThisWorkbook.Worksheets("SIRALAMA")
ShtHdf.Range("A2", ShtHdf.Cells(Rows.Count, "XFD")).Clear
SonStr = Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row
If SonStr < 2 Then GoTo son
If SonStr = 2 Then
ShtHdf.Range("A2").Value = Sht.Range("A2").Value
GoTo son
End If
StrSay = (SonStr - 1) \ sutun + 1
ReDim Dizi(StrSay, sutun)
DiziKynk = Sht.Range("A2:A" & SonStr)
i = 0
For StrX = LBound(DiziKynk) To UBound(DiziKynk)
Dizi(((StrX - 1) \ sutun), (StrX - 1) Mod sutun) = DiziKynk(StrX, 1)
Next StrX
ShtHdf.Range("A2").Resize(UBound(Dizi, 1), sutun).Value = Dizi
ShtHdf.Range("A2").Resize(UBound(Dizi, 1), sutun).Borders.LineStyle = 1
son:
On Error Resume Next
Erase Dizi: Set Sht = Nothing: Set ShtHdf = Nothing
MsgBox "bitti"
End Sub
