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

Question

我是VBA的新手。

将数据从一个工作簿中的列转移到另一个工作簿，因为行正在抛出错误。试图从这个论坛和其他地方提出建议，但没有成功。

任何帮助将高度赞赏 -

**

错误运行时错误1004 - Range类> PasteSpecial方法失败

**

代码 -

*

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

这似乎工作： 它，做同样的事情 复制/粘贴方法的简单示例仅适用于活动对象（如，床单，范围等） 所以你需要激活一个，然后另一个，

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