如何用Excel VBA将每950行数据转至新工作表的不同列？

当然可以实现，你之前用Transpose没达到预期，是因为Transpose是把行转成列、列转成行，而你需要的是把连续的行块依次放到不同列，用直接复制粘贴或者数组批量处理会更合适。

方法一：直接复制粘贴（直观易理解） #

这种方法逻辑简单，适合新手调试，直接循环截取每950行的A列数据，粘贴到Sheet2对应的列：

Sub SplitRowsToColumns()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim totalRows As Long
    Dim groupSize As Long
    Dim totalGroups As Integer
    Dim i As Integer
    
    ' 定义基础参数
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set targetSheet = ThisWorkbook.Sheets("Sheet2")
    groupSize = 950 ' 每组行数
    totalRows = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row ' 获取A列总行数
    totalGroups = WorksheetFunction.Ceiling(totalRows / groupSize, 1) ' 计算总组数（向上取整）
    
    ' 清空目标表原有数据
    targetSheet.Cells.Clear
    
    ' 循环处理每组数据
    For i = 1 To totalGroups
        ' 计算当前组的起始行和结束行
        Dim startRow As Long
        Dim endRow As Long
        startRow = (i - 1) * groupSize + 1
        endRow = Application.Min(i * groupSize, totalRows) ' 最后一组可能不足950行
        
        ' 复制源区域，粘贴到目标列
        sourceSheet.Range("A" & startRow & ":A" & endRow).Copy
        targetSheet.Cells(1, i).PasteSpecial Paste:=xlPasteValues ' 只粘贴值，需保留格式可改用xlPasteAll
    Next i
    
    ' 取消复制状态
    Application.CutCopyMode = False
End Sub

方法二：数组批量处理（效率更高，适合大数据） #

如果数据量很大（比如几万行），用数组操作比复制粘贴快得多，原理是先把源数据读到数组，再按组分配到目标数组，最后一次性写入工作表：

Sub SplitRowsToColumns_Array()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceArr As Variant
    Dim targetArr As Variant
    Dim totalRows As Long
    Dim groupSize As Long
    Dim totalGroups As Integer
    Dim i As Integer
    Dim rowIdx As Long
    Dim colIdx As Integer
    
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set targetSheet = ThisWorkbook.Sheets("Sheet2")
    groupSize = 950
    totalRows = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    totalGroups = WorksheetFunction.Ceiling(totalRows / groupSize, 1)
    
    ' 读取源数据到数组（从A1到最后一行）
    sourceArr = sourceSheet.Range("A1:A" & totalRows).Value
    
    ' 定义目标数组：行数是每组大小，列数是总组数
    ReDim targetArr(1 To groupSize, 1 To totalGroups)
    
    ' 遍历源数据，填充到目标数组对应位置
    For rowIdx = 1 To totalRows
        colIdx = WorksheetFunction.Ceiling(rowIdx / groupSize, 1) ' 当前行所属的目标列
        Dim targetRow As Long
        targetRow = ((rowIdx - 1) Mod groupSize) + 1 ' 当前行在目标列中的行号
        targetArr(targetRow, colIdx) = sourceArr(rowIdx, 1)
    Next rowIdx
    
    ' 清空目标表并写入数组数据
    targetSheet.Cells.Clear
    targetSheet.Range("A1").Resize(groupSize, totalGroups).Value = targetArr
End Sub

注意事项 #

• 运行代码前确保Sheet2存在，也可以在代码里添加判断逻辑自动创建工作表
• 若需保留单元格格式，方法一里把xlPasteValues替换为xlPasteAll即可
• 数组法默认只处理单元格值，要保留格式优先用复制粘贴方案

内容的提问来源于stack exchange，提问作者Firefaded