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

我是VBA新手。

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

任何帮助将不胜感激 –

**

错误运行时错误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 eg 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