対象のブックからすべてのシートをコピー

Question

実行時エラー '2147が発生しています。私の人生のために、私は何が欠けているのか分かりません。

私がしようとしているのは、現在の仕事の中から選択したブックを開いて、すべてのシートにコピーすることです。

ありがとうございます。

Sub GetFile() 

Dim fNameAndPath As Variant 
Dim wb As Workbook, wb2 As Workbook 
Dim Ws    As Worksheet 

fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Select File To Be Opened") 
If fNameAndPath = False Then Exit Sub 
Workbooks.Open Filename:=fNameAndPath 

Application.ScreenUpdating = False 

    Set wb = ActiveWorkbook 
    Set wb2 = Workbooks.Add(fNameAndPath) 

For Each Ws In wb2.Worksheets 
    Ws.Copy After:=wb.Sheets(wb.Sheets(1)) 
Next Ws 

Application.ScreenUpdating = True 

End Sub 

Answer 1

Public Sub this() 
    Dim path As String, fileName As String 
    Dim sheet As Worksheet, thisWB As Workbook, thatWB As Workbook 
    Dim arr() As Variant 
    Dim rowC As Long, colC As Long 
    path = "C:\Users\dcoats\Desktop" & "\" 
    fileName = Dir(path & "*.xl??") 
    Set thisWB = ThisWorkbook 
    Do While Len(fileName) > 0 
     Set thatWB = Workbooks.Open(path & fileName, True, True) 
      For Each sheet In thatWB.Sheets 
       arr = sheet.UsedRange 
       rowC = sheet.UsedRange.Rows.Count 
       colC = sheet.UsedRange.Columns.Count 
       thisWB.Sheets.Add After:=Worksheets(Worksheets.Count) 
       thisWB.ActiveSheet.Range(thisWB.ActiveSheet.Cells(1, 1), thisWB.ActiveSheet.Cells(rowC, colC)).Value2 = arr 
      Next sheet 
     thatWB.Close False 
     fileName = Dir() 
    Loop 
End Sub 

これはあなたのために働く必要があります。ディレクトリ内のすべてのファイルをループしても慎重です（私は基本的にはコピー/貼り付けて残念です）。