転置を使用して固まった

Question

他のブックからデータをマスターブックに抽出しようとしました。これらのブックはすべて1つのフォルダに保存されていました。そして、手動ではなく他のワークブックを自動的に開こうと思っていました。抽出する必要があるデータは隣接していないセルであり、各ソースブックから抽出したデータをマスターワークブックの行に表示する必要があります（行1に見出しがあるため、最初のブックからデータを抽出した後行2に貼り付けると、2番目のワークブックから抽出されたデータが3行目などに表示されます）

しかし、マクロを実行すると、私はTransposeに固執しました。以下は

私のコードは、私がこれまで行ってきた何

Sub LoopThroughDirectory() 
    Dim MyFile As String 
    Dim wkbSource As Workbook 
    Dim wkbTarget As Workbook 
    Dim erow As Single 
    Dim Filepath As String 
    Dim copyRange As Range 
    Dim cel As Range 
    Dim pasteRange As Range 

    Filepath = "C:\xxxxx\" 
    MyFile = Dir(Filepath) 

    Do While Len(MyFile) > 0 
     If MyFile = "Import Info.xlsm" Then GoTo NextFile  
     Set wkbTarget = Workbooks("Import Info.xlsm") 

     Set wkbSource = Workbooks.Open(Filepath & MyFile) 
     Set copyRange = wkbSource.Sheets("sheet1").Range("c3,f6,f9,f12,f15,f19,f21,f27,f30,f33,f37,f41") 
     Set pasteRange = wkbTarget.Sheets("sheet1").Range("a1") 

     For Each cel In copyRange 
      cel.Copy 
      ecolumn = wkbTarget.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Column 
      wkbTarget.Worksheets("Sheet1").Paste Destination:=wkbTarget.Worksheets("Sheet1").Range(Cells(1, ecolumn).Address) 
      pasteRange.Cells(1, ecolumn).PasteSpecial xlPasteValues 

     Next 
     Application.CutCopyMode = False 

     wkbSource.Close 

    NextFile: 
     MyFile = Dir 

    Loop 

End Sub 

です：

1. を私はソースワークブックから抽出したデータを転置が、彼らは私が期待したものとして、マスターワークブックに示されていませんでした。それらのすべてが1列目にあります
2. VBAでの経験はあまりなく、隣接しないセルをコピーして、マスターワークブック内で転置したコードがループをはるかに複雑にしているように感じます。しかし、私はどこが間違っているのか、それをどう解決するのか分かりません。

私を助けてください。どうもありがとうございます！

Answer 1

あなたはループの外で先範囲を設定し、ループの内側にオフセットする必要があります。

Sub LoopThroughDirectory() 
    Dim Filepath As String, MyFile As String 
    Dim wkbSource As Workbook, wkbTarget As Workbook 
    Dim copyRange As Range, cel As Range, pasteRange As Range 

    Set wkbTarget = Workbooks("Import Info.xlsm") 
    Set pasteRange = wkbTarget.Sheets("sheet1").Range("a2") ' start at row 2 

    Filepath = "C:\xxxxx\" 
    MyFile = Dir(Filepath) 

    While MyFile > "" 
     If MyFile = "Import Info.xlsm" Then GoTo NextFile  

     Set wkbSource = Workbooks.Open(Filepath & MyFile) 
     Set copyRange = wkbSource.Sheets("sheet1").Range("c3,f6,f9,f12,f15,f19,f21,f27,f30,f33,f37,f41") 

     For Each cel In copyRange 

      pasteRange.Value = cel.Value ' "copy" the value 

      Set pasteRange = pasteRange.Offset(, 1) ' move to the next column 

     Next 

     wkbSource.Close 

     Set pasteRange = pasteRange.EntireRow.Resize(1,1) ' move back to the first cell in the row 

     Set pasteRange = pasteRange.Offset(1) ' move to the cell bellow (next row) 

    NextFile: 
     MyFile = Dir 

    Wend  
End Sub