运行时错误“1004”没有发现单元格错误
我下面的代码显示了如何过滤某个范围取决于列的值。 每当我尝试第二种情况和第三种情况下，我得到运行时错误。
嗨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 我已经添加了一个variables来存储Select Case的条件，并且只有在过滤的logging时才将值复制到剪贴板。 过滤的行上的复制只会复制可见的行。
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
我不知道你想要做什么的值，但在这个私人小组的结尾可能有行复制到剪贴板。 在没有logging的情况下进行一些错误控制可能是适当的。 sCriteria似乎拥有目标工作表的名称。