Excel VBA: 将数据从一个工作簿中的列转置到另一个工作簿中的行

Question

我是 VBA 的新手。

将数据从一个工作簿中的列转换为另一个工作簿中的行会引发错误。尝试了 Stack Overflow 和其他地方的建议，但没有成功。

Error Runtime Error 1004 -> PasteSpecial method of Range class failed

代码：

Sub Button1_Click()
Dim MyFile As String
Dim erow
Dim FilePath As String
FilePath = "C:\trial\"
MyFile = Dir(FilePath)
Do While Len(MyFile) > 0
If MyFile = "here.xlsm" Then
Exit Sub
End If
'Opening data.xls to pull data from one column with 2 values (E6 and E7)
Workbooks.Open (FilePath & MyFile), Editable:=True
Dim SourceRange As Range
Set SourceRange = ActiveSheet.Range("E6:E7")
SourceRange.Copy
ActiveWorkbook.Close SaveChanges:=True
'Back to calling file - here.xlsm and pasting both values in single row (for e.g. A2 and B2)
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Dim targetRange As Range
Set targetRange = ActiveSheet.Cells(erow, 1)
targetRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
MyFile = Dir
Loop
End Sub

Answer 1

因为不能同时做两个值和转置

试试这个：

Sub Button1_Click()
Dim MyFile As String
Dim erow
Dim FilePath As String
Dim swb As Workbook
Dim twb As Workbook

Set twb = ThisWorkbook
FilePath = "C:\trial\"

MyFile = Dir(FilePath)
Do While Len(MyFile) > 0
    If MyFile = "here.xlsm" Then
        Exit Sub
    End If
    'Change "Sheet1" below to the actual name of the sheet
    erow = twb.Sheets("Sheet1").Cells(twb.Sheets("Sheet1").Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    'Opening data.xls to pull data from one column with 2 values (E6 and E7)
    Set swb = Workbooks.Open(FilePath & MyFile)
    'assign values
    twb.Sheets("Sheet1").Cells(erow, 1).Resize(, 2).Value = Application.Transpose(swb.ActiveSheet.Range("E6:E7").Value)
    'close
    swb.Close SaveChanges:=True

    MyFile = Dir
Loop
End Sub

Answer 2

这似乎有效：这是一个做同样事情的更简单的例子 copy/paste 方法仅适用于活动对象（如工作表、范围等）所以你需要先激活一个，然后再激活另一个，

Sub tst1()
Dim inbook, outbook As Workbook
Dim inSheet, outSheet As Worksheet
Dim inRange, outRange As Range


Set inbook = Application.Workbooks("temp1.xlsx")
Set outbook = Application.Workbooks("temp2.xlsx")

Set inSheet = inbook.Worksheets("sheet1")
Set outSheet = outbook.Worksheets("sheet1")

inSheet.Activate

Set inRange = ActiveSheet.Range("a1:b4")
inRange.Copy

outSheet.Activate
Set outRange = ActiveSheet.Range("a1:d2")
outRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

End Sub

Excel VBA: 将数据从一个工作簿中的列转置到另一个工作簿中的行

Excel VBA: Transpose data from columns in one Workbook to rows in another workbook

excel

vba

transpose

rows