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