2017-02-02 48 views
0

我想從工作表中複製一些過濾的數據並將其粘貼到我在編碼中創建的新csv文件中。我收到錯誤「範圍類的粘貼方法失敗」。有任何想法嗎?VBA:範圍類的粘貼方法失敗

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 
+0

任何細胞被複制到合併單元格? –

+1

您還需要限定要在哪個表上出現'Rows.Count'和'Columns.Count'。看看你如何用Range()來做到這一點?您需要將工作簿和工作表添加到「Rows.Count」和「Columns.Count」中。最後,不要使用'Selection.Copy',只需執行'wkb.Sheets(1).Range(「A1」)。Resize(Rows.Count,Columns.Count).Copy'。另外,可能在保存工作簿之後添加'Copy'部分*,以防止剪貼板出現問題。最後,你只需要複製數據的值? – BruceWayne

+0

沒有細胞被複制 – Navid

回答

0

我解決了這個代碼的問題:

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 
相關問題