我的代碼適用於粘貼但不粘貼特殊轉置

Question

我有一些代碼從多個封閉的工作簿中複製一列數據並將其粘貼到一個主工作簿中。

到目前爲止，代碼運行良好，但它將數據粘貼到單個列中 - 它粘貼關閉的工作簿1中的數據，然後找到下一個空行並將數據從其下面的關閉工作簿2粘貼，等等。我需要它在粘貼時「轉置」數據，因此數據會穿過該行。

我已經成功獲得了Paste Special Transpose代碼，以在另一個工作簿中自行工作，但是當我嘗試將其插入到我的代碼中時，要替換現有的Paste行，我得到運行時錯誤1004'PasteSpecial方法的Range班級失敗'

有人可以幫忙嗎？

這裏是我的代碼，用「選擇性粘貼部分在前面

Sub LoopThroughDirectory() 

Dim MyFile As String 

Dim erow 

Dim Filepath As String 

Filepath = "Z:\Functional workstreams\Risk and compliance\Compliance steering group\Life & Limb\RETURNS - 2017\Test\" 

MyFile = Dir(Filepath) 
Do While Len(MyFile) > 0 

Workbooks.Open (Filepath & MyFile) 
Range("D3:D24").Copy 

Application.DisplayAlerts = False 

ActiveWorkbook.Close 

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 

'ActiveSheet.Cells(erow, 1).Select 

'Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=True 

ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 25)) 

MyFile = Dir 
Loop 
End Sub 

Answer 1

您要關閉工作簿，並通過這樣做，你失去了粘貼特殊的能力。

嘗試將工作簿分配給變量，然後在粘貼範圍後使用該變量關閉工作簿。

Sub LoopThroughDirectory() 
    Dim MyFile As String 
    Dim erow 
    Dim Filepath As String 
    Dim wb As Workbook, src_wb As Workbook 
    Dim ws As Worksheet 

    Set wb = ThisWorkbook 
    Set ws = wb.ActiveSheet 
    Filepath = "Z:\Functional workstreams\Risk and compliance\Compliance steering group\Life & Limb\RETURNS - 2017\Test\" 

    MyFile = Dir(Filepath) 

    Do While Len(MyFile) > 0 
     Set src_wb = Workbooks.Open(Filepath & MyFile) 
     Range("D3:D24").Copy 

     Application.DisplayAlerts = False 

     erow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 

     ws.Range("A" & erow).PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=True 
     src_wb.Close False 

     MyFile = Dir 
    Loop 
End Sub