Sub CopyText()
Dim sourceText As String
Dim targetSheet As Worksheet
Dim targetRow As Integer
Dim targetColumn As Integer
Dim i As Integer
'获取源文本
sourceText = Sheet1.Range("A1").Value
'设置目标工作表
Set targetSheet = ThisWorkbook.Sheets("Sheet2")
'计算目标行和列
targetRow = 1
targetColumn = 3
'逐字复制文本到目标工作表
For i = 1 To Len(sourceText)
targetSheet.Cells(targetRow, targetColumn).Value = Mid(sourceText, i, 1)
targetColumn = targetColumn + 1
If Mid(sourceText, i, 1) = Chr(10) Then
targetRow = targetRow + 1
targetColumn = 3
End If
'如果列数达到15，则换行并重置列数
If targetColumn > 15 Then
targetRow = targetRow + 1
targetColumn = 1
End If
Next i
End Sub