Sub ayir()
Dim deg As String, i As Long, k As Integer
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("B2:F2").ClearContents
For i = 1 To Cells(65536, "A").End(xlUp).Row
    deg = Cells(i, "A").Value
    sut = 1
    Range("A" & i & ":G" & i).ClearContents
    For k = 1 To Len(deg) Step 40
        If k + 39 < Len(deg) Then
            Cells(i, sut).Value = Mid(deg, k, 40)
            sut = sut + 1
            Else
            Cells(i, sut).Value = Left(deg, Len(deg) - k + 1)
            sut = sut + 1
        End If
    Next
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır.", vbOKOnly + vbInformation, "E V R E N"
End Sub