VBA：範囲クラスの貼り付けメソッドが失敗しました

Question

フィルタ処理されたデータをワークシートからコピーし、コード内に作成した新しいcsvファイルに貼り付けようとしています。 「範囲クラスの貼り付けメソッドが失敗しました」というエラーが表示されます。何か案は？

Sub Button1_Click() 
Dim wkb As Excel.Workbook 
Dim wkb2 As Excel.Workbook 
Dim answer As Integer 
Dim crtra1 As String 
Dim crtra2 As String 
Dim path 
UserForm1.Show 
path = ThisWorkbook.path & "\" & fldr & "\BookHierarchy.csv" 
    Set wkb = Application.Workbooks.Open(path) 
    crtra1 = "TOTUS" 
    crtra2 = "US" 
    wkb.Sheets(1).Range("A1").Resize(Rows.Count, Columns.Count).AutoFilter Field:=13, Criteria1:="=*" & crtra1 & "*" 
    wkb.Sheets(1).Range("A1").Resize(Rows.Count, Columns.Count).AutoFilter Field:=14, Criteria1:="=" & crtra2 
    wkb.Sheets(1).Range("A1").Resize(Rows.Count, Columns.Count).Select 

    Selection.Copy 
    Workbooks.Add 
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.path & "\TOTUS_Books_US_Mapped.csv" 
    path = ThisWorkbook.path & "\TOTUS_Books_US_Mapped.csv" 
    Set wkb2 = Application.Workbooks.Open(path) 
    'ActiveWorkbook.Sheets(1).Select 
    'ActiveWorkbook.Sheets(1).Range("A1").Select 
    wkb2.Sheets(1).Range("A1").PasteSpecial 
    Application.CutCopyMode = False 
     wkb.Sheets(1).AutoFilterMode = False 
End Sub 

Answer 1

私はこのコードの問題を解決しました：

Sub Button1_Click() 
    Dim wkb As Excel.Workbook 
    Dim wkb2 As Excel.Workbook 
    Dim answer As Integer 
    Dim crtra1 As String 
    Dim crtra2 As String 
    Dim path 
    Dim rw As Integer 
    Dim clm As Integer 
    UserForm1.Show 
    path = ThisWorkbook.path & "\" & fldr & "\BookHierarchy.csv" 
    Set wkb = Application.Workbooks.Open(path) 
    crtra1 = "TOTUS" 
    crtra2 = "US" 
    wkb.Sheets(1).Range("A1").Resize(Rows.Count, Columns.Count).AutoFilter Field:=13, Criteria1:="=*" & crtra1 & "*" 
    wkb.Sheets(1).Range("A1").Resize(Rows.Count, Columns.Count).AutoFilter Field:=14, Criteria1:="=" & crtra2 

    rw = wkb.Sheets(1).UsedRange.Rows.Count 
    clm = wkb.Sheets(1).UsedRange.Columns.Count 

    Workbooks.Add 
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.path & "\TOTUS_Books_US_Mapped.csv" 
    path = ThisWorkbook.path & "\TOTUS_Books_US_Mapped.csv" 
    Set wkb2 = Application.Workbooks.Open(path) 
    wkb.Sheets(1).Range("A1").Resize(rw, clm).Copy 

    wkb2.Sheets(1).Paste 
    Application.CutCopyMode = False 
     wkb.Sheets(1).AutoFilterMode = False 
End Sub