VBA運行時錯誤'1004'：工作表類的粘貼方法失敗

Question

起初此代碼是「排序工作」，這意味着它會將信息粘貼到目標但不在正確的單元格中，並添加額外的行而不是跳過空行。一旦我將它正確地粘貼到適當的單元格上，它就不再需要工作了。

我相信這是一個相當簡單的問題，但我很茫然。任何幫助將不勝感激

Private Sub CommandButton1_Click() 

Dim Myfile As String 
Dim erowFilepath = ("C:\Users\YOU DONT NEED TO SEE THIS PART\Desktop\LINKED TRACKERS\") 
Myfile = Dir("C:\Users\OR THIS PART\Desktop\LINKED TRACKERS\") 

Do While Len(Myfile) > 0 
    If Myfile = "COMPANY_CYCLE.xlsm" Then 
     Exit Sub 
    End If 

    Workbooks.Open (Filepath & Myfile) 
    Worksheets("ROSTER").Range("A3:O3").Copy 
    ActiveWorkbook.Save 
    ActiveWorkbook.Close 

    erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
    ' ***The line below is the line I get an error*** 
    ActiveSheet.Paste Destination:=Worksheets("MANNINGROSTER").Range(Cells(erow, 1), Cells(erow, 1)) 

    Myfile = Dir 
Loop 

End Sub 

長話短說：我試圖合併來自4個不同的工作簿中的數據，用戶將輸入數據到一個工作簿，因爲它是擺在那我可以監控和處理信息日復一日。

我相當確定問題源於受密碼保護的源工作表，並且所有4個工作簿的粘貼目標也是相同的。

我似乎無法找出解決方法。一個錯誤導致另一個，另一個等

Answer 1

Private Sub CommandButton1_Click() 

    Dim Myfile As String, Filepath As String 
    Dim wb As Workbook, rng As Range 

    Myfile = Dir("C:\Users\OR THIS PART\Desktop\LINKED TRACKERS\") 
    Filepath = ("C:\Users\YOU DONT NEED TO SEE THIS PART\Desktop\LINKED TRACKERS\") 

    Do While Len(Myfile) > 0 

     If Myfile Like "*.xls*" And UCase(Myfile) <> "COMPANY_CYCLE.XLSM" Then 

      Set wb = Workbooks.Open(Filepath & Myfile) 
      Set rng = wb.Worksheets("ROSTER").Range("A3:O3") 

      'EDIT: copy values only, (when there's something to copy) 
      If Application.CountA(rng) > 0 Then 
       With Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 
        .Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value 
       End With 
      End If 
      'Note: if there's nothing in ColA for the copied range, this will 
      ' throw off the next copy and you may end up overwriting data... 

      wb.Close False 

     End If 
     Myfile = Dir 
    Loop 

End Sub