Мой код работает с пастой, но не с вставкой. Специальная трансформация

Question

У меня есть код, который копирует столбец данных из нескольких закрытых книг и вставляет его в одну основную книгу.

Код хорошо работает до сих пор, но он вставляет данные в один столбец - вставляет данные из закрытой рабочей книги 1, затем находит следующую пустую строку и вставляет данные из закрытой книги 2 под ней и т. Д. Мне нужно, чтобы он «транспонировал» данные, когда они вставляются, поэтому данные переходят через строку.

Я успешно получил специальный код Transpose Transpose для работы самостоятельно в другой книге, но когда я пытаюсь вставить его в свой код, чтобы заменить существующие строки Paste, я получаю Runtime error 1004 'PasteSpecial method of Range класс не удался '

Может кто-нибудь помочь?

Вот мой код, с Paste Особенной части с 'перед

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