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

m0_55547585 2025-01-15 00:17:09

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