在VBA上覆制和粘貼動態範圍，錯誤：object_worksheet的範圍，

Question

我已經寫入/散列過一個程序，用於複製一行數據，當行符合某個標準（列A =「1」）工作簿位於桌面上的測試文件夾中;該計劃最初的工作，但現在在這裏拉了一個錯誤：

ws.Range(ws.Cells(r, 1), Cells(r, 20)).Copy Destination:=ThisWorkbook.Sheets("SummaryAccrual").Range("A" & lr2 + 1) 

一旦進行排序，我也擔心，複製和粘貼此方法將粘貼公式，而不是值，有一個簡單的方法來粘貼值？

感謝您的幫助，我非常感謝！

我的代碼

Option Explicit 

Sub AccrualCombiner() 

Dim Path As String 
Dim FileName As String 
Dim Wkb As Workbook 
Dim cWkb As Workbook 
Dim ws As Worksheet 
Dim answer As Integer 
Dim lr As Long, lr2 As Long, r As Long 
Dim rc As Object 

Application.EnableEvents = False 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.AskToUpdateLinks = False 

answer = MsgBox("Would you like to combine Accruals for current period?", vbYesNo + vbQuestion, "Confirmation") 

If answer = vbYes Then 
    Set cWkb = Application.ActiveWorkbook 
    lr2 = ThisWorkbook.Sheets("SummaryAccrual").Cells(Rows.Count, "A").End(xlUp).Row 

    Path = "C:\Users\alexander.neale\Desktop\Test" 
    FileName = Dir(Path & "\*.xls", vbNormal) 

    Do Until FileName = "" 

     Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName) 
     For Each ws In Wkb.Worksheets 
      For r = 14 To 60 Step 1 
       If ws.Range("A" & r).Value = "1" Then 
        ws.Range(ws.Cells(r, 1), Cells(r, 20)).Copy Destination:=ThisWorkbook.Sheets("SummaryAccrual").Range("A" & lr2 + 1) 
        lr2 = ThisWorkbook.Sheets("SummaryAccrual").Cells(Rows.Count, "A").End(xlUp).Row 
       End If 
      Next r 
     Next ws 
     Wkb.Close False 
     FileName = Dir() 
    Loop 

    Application.EnableEvents = True 
    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 
    Application.AskToUpdateLinks = True 
End If 

End Sub 

Answer 1

這是你的問題：

ws.Range(ws.Cells(r, 1), Cells(r, 20)).Copy 

第二Cells沒有指定所以它會假設你的意思是活動錶板。如果活動工作表不是ws，那麼它將失敗，因爲範圍不能跨越多個工作表。因此，使用

ws.Range(ws.Cells(r, 1), ws.Cells(r, 20)).Copy 

或

With ws 
    .Range(.Cells(r, 1), .Cells(r, 20)).Copy .... 
End With 

---

編輯：粘貼僅值，無論是剛剛設置的範圍.Value財產，像user3598756建議：

ThisWorkbook.Sheets("SummaryAccrual").Range("A" & lr2 + 1).Resize(1, 20).Value = ws.Range(ws.Cells(r, 1), ws.Cells(r, 20)).Value 

或使用PasteSpecial與xlPasteValues選項：

ws.Range(ws.Cells(r, 1), ws.Cells(r, 20)).Copy 
ThisWorkbook.Worksheets("SummaryAccrual").Range("A" & lr2 + 1).PasteSpecial xlPasteValues 

第一個選項通常要快得多。

Answer 2

，因爲你關注的只是粘貼值，這應該是更快：

Option Explicit 

Sub AccrualCombiner() 
    Dim Path As String 
    Dim FileName As String 
    Dim Wkb As Workbook 
    Dim ws As Worksheet 
    Dim answer As Integer 
    Dim r As Long 

    answer = MsgBox("Would you like to combine Accruals for current period?", vbYesNo + vbQuestion, "Confirmation")   
    If answer = vbYes Then 
     Application.EnableEvents = False 
     Application.ScreenUpdating = False 
     Application.DisplayAlerts = False 
     Application.AskToUpdateLinks = False 

     Path = "C:\Users\alexander.neale\Desktop\Test" 
     With ThisWorkbook.Worksheets("SummaryAccrual") 
      FileName = Dir(Path & "\*.xls", vbNormal) 
      Do Until FileName = "" 
       Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName) 
       For Each ws In Wkb.Worksheets 
        If WorksheetFunction.CountIf(ws.Range(ws.Cells(14, 1), ws.Cells(60, 1)), "1") > 0 Then 
         For r = 14 To 60 Step 1 
          If ws.Range("A" & r).Value = "1" Then 
           .Cells(.Rows.COUNT, "A").End(xlUp).Offset(1).Resize(, 20).Value = ws.Range(ws.Cells(r, 1), ws.Cells(r, 20)).Value 
          End If 
         Next r 
        End If 
       Next ws 
       Wkb.Close False 
       FileName = Dir() 
      Loop 
     End With 

     Application.EnableEvents = True 
     Application.ScreenUpdating = True 
     Application.DisplayAlerts = True 
     Application.AskToUpdateLinks = True 
    End If 
End Sub