求助帖，VBA一个列数据转行数据实在不懂，总显示下标越界错误

[m0_55547585]

Sub CopyDataFromClosedWorkbookToAnother()
    Dim sourceWorkbookPath As String
    Dim sourceWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim targetRange As Range
    
 
    sourceWorkbookPath = "D:\1111.xlsx" ' 替换为实际的文件路径
    
    ' 设置目标工作簿（当前工作簿）
 Set targetWorkbook = Workbooks("2025环保数据表.xlsm")
    
    ' 在后台打开源工作簿（不显示警告信息）
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    Set sourceWorkbook = Workbooks.Open(sourceWorkbookPath)
    On Error GoTo 0
    
    If sourceWorkbook Is Nothing Then
        MsgBox "无法打开源工作簿，请检查路径是否正确！", vbCritical
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Exit Sub
    End If
    
    ' 设置源工作表和目标工作表
    Set sourceSheet = sourceWorkbook.Sheets("Sheet1")
    Set targetSheet = targetWorkbook.Sheets("Sheet3")
    
    ' 设置源数据范围和目标范围
    Set sourceRange = sourceSheet.Range("I3:I14") ' 更正为整个列范围
    ' Set targetRange = targetSheet.Rows(8) ' 更简单的方法，直接设置整行
    ' 或者使用Resize方法，但确保参数正确（这里不需要改变列数，因为我们是列到行的“转置”）
    Set targetRange = targetSheet.Range("C8").Resize(1, sourceRange.Cells.Count) ' 虽然这里Resize的参数是正确的，但直接设置整行更清晰
    
    ' 复制数据（使用Value2进行赋值）
    targetRange.Value2 = sourceRange.Value2 ' 直接赋值整个范围
    
    ' 关闭源工作簿（不保存更改）
    sourceWorkbook.Close SaveChanges:=False
    
    ' 恢复屏幕更新和自动弹出的提示信息
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    ' 清理对象变量
    Set sourceRange = Nothing
    Set targetRange = Nothing
    Set sourceSheet = Nothing
    Set targetSheet = Nothing
    ' 注意：sourceWorkbook和targetWorkbook在关闭后会自动设置为Nothing（但targetWorkbook没有关闭）
End Sub

 

 

[2301_77994268]

列转行，用函数也比较方便