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