2017-09-27 9 views
-1

私は本当に助けに感謝します。複数のワークブックのワークシートを1つのワークブックにコピーすると、右側に貼り付けます

複数のブックのSheet1からF37:F53の範囲を取り込み、新しいブックのSheet1に貼り付けようとしています。私が持っている1つの問題は、すべてのデータが1つの列にペーストされることです。私が実際に望むのは、右の列に貼り付ける各データセットです。したがって、最終的なワークブックのA1には、ワークブック1のF37:F53を貼り付ける必要があります。ブック2 F37:F53は、最後のブックのB1に貼り付けられる必要があります。私はVBA

にかなり新しいです事前にありがとうございますようになど365列

の限界と私は本当にいくつかの助けをいただければ幸いです!ここで

は、私がこれまで持っているものである:これはちょうどあなたが、私はRDBMergeを示唆して迅速に必要なものである場合

Sub simpleXlsMerger() 
Dim bookList As Workbook 
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object 
Application.ScreenUpdating = False 
Set mergeObj = CreateObject("Scripting.FileSystemObject") 

Set dirObj = mergeObj.Getfolder("C:\Users\a0086850\Documents\421\2017") 
Set filesObj = dirObj.Files 
For Each everyObj In filesObj 
Set bookList = Workbooks.Open(everyObj) 

Range("F37:F53" & Range("F65536").End(xlUp).Row).Copy 
ThisWorkbook.Worksheets("2017").Activate 

Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial 
Application.CutCopyMode = False 
bookList.Close 
Next 
End Sub 

答えて

0

はFSOビットが正しいと仮定すると、この

Sub simpleXlsMerger() 

Dim bookList As Workbook 
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object 
Dim c As Long 

Application.ScreenUpdating = False 

Set mergeObj = CreateObject("Scripting.FileSystemObject") 
Set dirObj = mergeObj.Getfolder("C:\Users\a0086850\Documents\421\2017") 
Set filesObj = dirObj.Files 

For Each everyObj In filesObj 
    Set bookList = Workbooks.Open(everyObj) 
    c = c + 1 
    bookList.Sheets(1).Range("F37:F53").Copy ThisWorkbook.Worksheets("2017").Cells(1, c) 
    bookList.Close 
Next 

End Sub 
+0

これは完璧に動作しました! –

0

を試してみてください。ワークブック/ワークシートをマージするための素晴らしいツールです。 RDBMerge

関連する問題