范围类的Pastespecial方法失败

范围类的Pastespecial方法失败

我需要你的帮忙。我真的不明白我的代码有什么问题。在这一点上,我总是收到错误消息:

Sheets.Add(After:=Sheets(Sheets.Count)).Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

错误消息是:范围类的Pastespecial方法失败

我想要的是过滤原始数据,然后将结果复制到工作簿中的新工作表中。

您有什么建议我的代码有什么问题吗?
提前谢谢你的帮助!
 Sub copypaste()

    Dim i, j, v As Long
    Dim vSearchCols As Variant
    Dim vCols As Variant
    Dim FilterFor As String

    FilterFor = "=AF*"
    Set s1 = ThisWorkbook.Worksheets("RAW DATA")
    Set s2 = ThisWorkbook.Worksheets("AF SITE TYPE")

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False


    With s1
        vSearchCols = Array("Prefix+short name", "Site type", "Probe Id", "Owner", "SLA Target", "Avg RTT (ms)", "Completion (ms)")
        ReDim vCols(0 To UBound(vSearchCols))
            For v = LBound(vSearchCols) To UBound(vSearchCols)
                vCols(v) = .rows(2).Cells.Find(What:=vSearchCols(v), LookIn:=xlFormulas, LookAt:=xlWhole).Column
            Next v
    End With

    With s1
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells.Resize(.rows.Count - 1, .Columns.Count).Offset(1, 0)
        If CBool(Application.Subtotal(103, .Cells)) Then
            .AutoFilter Field:=vCols(0), Criteria1:=FilterFor
            .Copy
            Sheets.Add(After:=Sheets(Sheets.Count)).Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            ActiveSheet.Name = "TEMP"
        End If
        End With
    End With

    End Sub

最佳答案

这应该工作:

Dim ws As Worksheet
Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
ws.Name = "TEMP"
With s1
    If .AutoFilterMode Then .AutoFilterMode = False
    With .Cells.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
    If CBool(Application.Subtotal(103, .Cells)) Then
        .AutoFilter Field:=vCols(0), Criteria1:=FilterFor
        .Copy
        ws.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End If
    End With
End With

或一些完全修改的代码:
Sub copypaste()

    Dim i, j, v               As Long
    Dim vSearchCols           As Variant
    Dim vCols                 As Variant
    Dim FilterFor             As String
    Dim ws                    As Worksheet
    Dim s1                    As Worksheet
    Dim s2                    As Worksheet


    FilterFor = "=AF*"
    With ThisWorkbook
        Set s1 = .Worksheets("RAW DATA")
        Set s2 = .Worksheets("AF SITE TYPE")
        Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    End With
    ws.Name = "TEMP"

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With

    vSearchCols = Array("Prefix+short name", "Site type", "Probe Id", "Owner", "SLA Target", "Avg RTT (ms)", "Completion (ms)")
    ReDim vCols(0 To UBound(vSearchCols))
    For v = LBound(vSearchCols) To UBound(vSearchCols)
        vCols(v) = s1.Rows(2).Cells.Find(What:=vSearchCols(v), LookIn:=xlFormulas, LookAt:=xlWhole).Column
    Next v

    With s1
        .AutoFilterMode = False
        With .Range("A1").CurrentRegion
            .AutoFilter Field:=vCols(0), Criteria1:=FilterFor
            If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
                .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
                ws.Range("A1").PasteSpecial Paste:=xlPasteValues
            End If
        End With
    End With
    With Application
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

10-05 19:03