运行时错误'1004'未找到单元格错误

Question

我的代码如下显示了如何根据列的值过滤某个范围。每当我尝试第二种情况和第三种情况时，我都会遇到运行时错误。

嗨Jeeped，请查看以下编辑代码：

Private Sub cmdATSend_Click() 
'************************************************************** 
'Copy Data 
'************************************************************** 

Dim myProject As String, sCriteria As String 

myProject = InputBox("On what sheet do you wish to transfer these data?", "Daily Alarms Tracker", "ONO, INFINITY, or NET Brazil?") 

With Sheets("Daily Alarms Tracker") 

    sCriteria = vbNullString 
    Select Case myProject 

     Case "INFINITY", "infinity", "Infinity", "inf", "Inf" 
      sCriteria = "INFINITY" 
     Case "ONO", "Ono", "ono" 
      sCriteria = "ONO" 
     Case "NET Brazil", "NET", "net brazil", "net", "Net Brazil", "NET BRAZIL" 
      sCriteria = "NET Brazil" 
    End Select 

    If CBool(Len(sCriteria)) Then 
     With .Range("C7:K18") 
      .AutoFilter 
      .AutoFilter Field:=1, Criteria1:=sCriteria 
      '.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Select 
      If CBool(Application.Subtotal(103, .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count))) Then 
       .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy 
      Else 
       Debug.Print "nothing matches" 
      End If 
     End With 
    End If 
End With 

'******************************************************************* 
'Paste Data 
'******************************************************************* 

    Dim atwb As Workbook 

    Set atwb = Workbooks.Open("https://ts.company.com/sites/folder1/folder2/01%20Project%20Documentations/Daily%20Alarms%20Tracker/Daily_Alarms_Tracker.xlsx") 
    Set atwb = ActiveWorkbook 

    Select Case sCriteria 

     Case "INFINITY" 
      Dim iRow As Long 

       With Sheets("INFINITY") 
        eRow = .Cells(Rows.Count, "B:B").End(xlUp).Row + 1 
        .Cells(iRow, "A").PasteSpecial xlPasteValuesAndNumberFormats 
       End With 

     Case "ONO" 
      Dim oRow As Long 

       With Sheets("ONO") 
        eRow = .Cells(Rows.Count, "B:B").End(xlUp).Row + 1 
        .Cells(oRow, "A").PasteSpecial xlPasteValuesAndNumberFormats 
       End With 

     Case "NET" 
      Dim nRow As Long 

       With Sheets("NET") 
        eRow = .Cells(Rows.Count, "B:B").End(xlUp).Row + 1 
        .Cells(nRow, "A").PasteSpecial xlPasteValuesAndNumberFormats 
       End With 

    End Select 

End Sub 

Answer 1

我添加了一个变量，从Select Case的标准，只有复制值存储到剪贴板时，有过滤的记录。过滤后的行上的.Copy只会复制可见的行。

Private Sub cmdATSend_Click() 
    Dim myProject As String, sCriteria As String, sTargetWS As String 
    Dim wb As Workbook, atWB As Workbook 

    myProject = InputBox("On what sheet do you wish to transfer these data?", "Daily Alarms Tracker", "ONO, INFINITY, or NET Brazil?") 

    'open the target wb now for direct use later 
    Set wb = ActiveWorkbook 
    Set atWB = Workbooks.Open("https://ts.company.com/sites/folder1/folder2/01%20Project%20Documentations/Daily%20Alarms%20Tracker/Daily_Alarms_Tracker.xlsx") 

    With wb.Sheets("Daily Alarms Tracker") 

     sCriteria = vbNullString: sTargetWS = vbNullString 
     Select Case myProject 

      Case "INFINITY", "infinity", "Infinity", "inf", "Inf" 
       sCriteria = "INFINITY" 
       sTargetWS = "INFINITY" 
      Case "ONO", "Ono", "ono" 
       sCriteria = "ONO" 
       sTargetWS = "ONO" 
      Case "NET Brazil", "NET", "net brazil", "net", "Net Brazil", "NET BRAZIL" 
       sCriteria = "NET Brazil" 
       sTargetWS = "NET" 
     End Select 

     If CBool(Len(sCriteria)) Then 
      With .Range("C7:k18") 
       .AutoFilter 
       .AutoFilter Field:=1, Criteria1:=sCriteria 
       'with .offset(1,0).resize(.rows.count-1, .columns.count) 
       If CBool(Application.Subtotal(103, .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count))) Then 
        .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1).Copy _ 
         Destination:=atWB.Sheets(sTargetWS).Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) 
       Else 
        Debug.Print "nothing matches" 
       End If 
      End With 
     End If 
    End With 

    'you could close the Daily_Alarms_Tracker workbook here 
    'atWB.Close savechanges:=True 

    Set atWB = Nothing 
    Set wb = Nothing 

End Sub 

我不确定你想要做什么的值，但在这个私人小组的结尾可能有行复制到剪贴板。在没有记录的情况下进行一些错误控制可能是适当的。看起来，sCriteria保存目标工作表的名称。