貼り付け複数のファイルの特殊転置

Question

まずは、まずマスターファイルを持っていきます。マスターファイルには、40の他のワークブックの名前があります。

この40個のワークブック（マスターファイルのA1〜A40で定義されている名前）で動作するVBAコードを記述する必要があります。このコードは各ワークブックに移動して開き、各ワークブックの最初のシートにデータをコピーする必要があります。

その後、マスターワークブックに戻り、特別な別の新しいシートに貼り付けられます。たとえば、workbookA1のデータはSheet1に、workbookA2のデータはSheet2に格納されます。しかし、私はそれにいくつかの問題を抱えています。エラーは、 "範囲クラスのPasteSpecialメソッド"に失敗しました。

Sub Macro2() 
    Dim thiswb As Workbook, datawb As Workbook 
    Dim datafolder As String 
    Dim cell As Range, datawblist As Range 
    Dim i As Integer 

    Set thiswb = ActiveWorkbook 
    i = 2 
    'Have the 40 file names in sheet2 of this workbook in cells A1:A40 
    Set datawblist = Sheets("command").Range("A1:A4") 
    datafolder = "C:\Users\bryan\Desktop\Y4S1\Money and Banking\Empirical\QuarterSheets\2012q1\" 'change this to your directory they're in 
    For Each cell In datawblist 
     Workbooks.Open Filename:=datafolder & cell & ".csv", ReadOnly:=True 
     Set datawb = ActiveWorkbook 
     Sheets(1).Select 'change this to the sheet name you need to copy from 
     Range("A1:XFD1048576").Select 
     Do Until ActiveCell.Value = "" 
      Selection.Copy 
      ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) 
      thiswb.Activate 
      ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) 
      Selection.PasteSpecial Paste:=xlPasteValues, _ 
       Operation:=xlNone, _ 
       SkipBlanks:=False, _ 
       Transpose:=True 
      ActiveCell.Offset(0, 4).Select 
      datawb.Activate 
      ActiveCell.Offset(0, 1).Select 
     Loop 
     datawb.Close savechanges:=False 
     thiswb.Activate 
     Sheets("command").Select 
     i = i + 1 
     Cells(i, 1).Select 
    Next 

End Sub 

Answer 1

SelectとActivateを削除し、コピーした範囲をすべての単一セルではなく使用範囲に制限してください。私はあなたのシナリオを正しく解釈したと思いますが、そうでない場合は叫びます。 =ワークシート（Worksheets.Count）：あなたがそれらを利用しようとする使用した後、このような `ActiveWorkbook.Sheets.Addとして` activeworkbook`を使用しないでくださいあなたはthiswb` `へdatawb``からコピーしよう

Sub Macro2() 

Dim thiswb As Workbook, datawb As Workbook, ws As Worksheet 
Dim datafolder As String 
Dim cell As Range, datawblist As Range 
Dim i As Long 

Set thiswb = ThisWorkbook 
i = 2 
'Have the 40 file names in sheet2 of this workbook in cells A1:A40 
Set datawblist = thiswb.Sheets("command").Range("A1:A4") 
datafolder = "C:\Users\bryan\Desktop\Y4S1\Money and Banking\Empirical\QuarterSheets\2012q1\" 'change this to your directory they're in 

For Each cell In datawblist 
    Set datawb = Workbooks.Open(Filename:=datafolder & cell & ".csv", ReadOnly:=True) 
    Set ws = thiswb.Sheets.Add(After:=thiswb.Worksheets(Worksheets.Count)) 
    datawb.Sheets(1).UsedRange.Copy 
    ws.Range("A1").PasteSpecial Paste:=xlPasteValues, _ 
     Operation:=xlNone, _ 
     SkipBlanks:=False, _ 
     Transpose:=True 
    datawb.Close savechanges:=False 
Next 

End Sub