運行時錯誤'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保存目標工作表的名稱。