将样式应用于单元格时出现 Excel VBA 粘贴错误

Question

我正在寻求一些帮助。我有一个代码可以满足我的需要并且工作得很好，但是我想让它做更多的事情，那就是它崩溃的时候。
这是代码，我知道有点乱:

    Sub AgainstAbstain()

    Application.ScreenUpdating = False

    'Stating variables
    Dim Abstain As String
    Abstain = "Abstain"
    Dim Against As String
    Against = "Against"
    Dim C11 As Variant

    'Enter amount of votable items
    Dim e As Byte 'number of agenda items
    e = InputBox("Number of votable items in Agenda?")

    'Create Necessary sheets
    On Error Resume Next
    Sheets("Abstain").Delete
    'Sheets("Against").Delete
    On Error GoTo 0
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    'ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveWorkbook.Sheets(2).Name = "Abstain"
    'ActiveWorkbook.Sheets(3).Name = "Against"

    'Change zoom level of sheets
    Sheets(2).Activate
    ActiveWindow.Zoom = 85
    'Sheets(3).Activate
    'ActiveWindow.Zoom = 85
    Sheets(1).Activate

    'For better copying of cells
    Cells.WrapText = False

    'To count spaces
    Dim j As Integer
    j = 1
    Dim k As Integer
    k = 1
    Dim c As Integer
    c = 3 '

    'Main filter and copy
    For i = 1 To e
    Worksheets(1).Cells(11, c).Select
    C11 = ActiveCell.Value
    'Range("A11:C11").Select
    Range(Cells(11, 1), Cells(11, c)).Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=c, Criteria1:="ABSTAIN"

    'Amount of items visible after filter
    Dim x As Integer
    x = Application.Subtotal(3, Columns("A")) - 19
    'MsgBox x

    If x > 0 Then
    ActiveSheet.AutoFilter.Range.Offset(1).Copy
        Sheets("ABSTAIN").Activate
    '    Range("A" & j).Select
    '    Range("A" & j).Font.Bold = True
    '    Range("A" & j).Font.Underline = True
        Range("A" & j).Value = C11 & ") " & Abstain
        j = j + 2
    '    Range("A" & j).Select
        Range("A" & j).Value = "Beneficial owner:"
        'Range("A" & j).Font.Bold = True
        Range("B" & j).Value = "Number of shares:"
        'Range("A" & j).Font.Bold = True
        j = j + 1
        Sheets(2).Range("A" & j).PasteSpecial
    '   Range("A" & j).Select
    '   ActiveSheet.Paste
        j = j + x
        Range("A" & j).Value = "Sum"
        Range("A" & j).Font.Bold = True
        Range("A" & j).Interior.Color = RGB(255, 204, 153)
        Range("B" & j).Font.Bold = True
        Range("B" & j).Interior.Color = RGB(255, 204, 153)
        j = j + 3
        Columns(3).EntireColumn.Delete
        Err.Clear
        Sheets(1).Activate
        Worksheets(1).Columns(c).Hidden = True
        c = c + 1
        Cells.AutoFilter
        Else: Cells.AutoFilter
        Worksheets(1).Columns(c).Hidden = True
        c = c + 1
    End If
    Next i

    Cells.EntireColumn.Hidden = False
    c = 3

    For i = 1 To e
    Worksheets(1).Cells(11, c).Select
    C11 = ActiveCell.Value
    'Range("A11:C11").Select
    Range(Cells(11, 1), Cells(11, c)).Select
    Selection.AutoFilter
    ActiveSheet.Range("C:C").AutoFilter Field:=c, Criteria1:="AGAINST"

    'Amount of items visible after filter
    Dim y As Integer
    y = Application.Subtotal(3, Columns("A")) - 19
    'MsgBox y

    If y > 0 Then
    ActiveSheet.AutoFilter.Range.Offset(1).Copy
        Sheets("Abstain").Activate
    '    Range("A" & j).Select
        Range("A" & j).Value = C11 & ") " & Abstain
        j = j + 2
    '    Range("A" & j).Select
        Range("A" & j).Value = "Beneficial owner:"
        Range("B" & j).Value = "Number of shares:"
        j = j + 1
        Sheets(2).Range("A" & j).PasteSpecial
    '    Range("A" & j).Select
    '    ActiveSheet.Paste
        j = j + y
        Range("A" & j).Value = "Sum"
        Range("A" & j).Font.Bold = True
        Range("A" & j).Interior.Color = RGB(255, 153, 204)
        Range("B" & j).Font.Bold = True
        Range("B" & j).Interior.Color = RGB(255, 153, 204)
        j = j + 3
        Columns(3).EntireColumn.Delete
        Err.Clear
        Sheets(1).Activate
        Worksheets(1).Columns(c).Hidden = True
        c = c + 1
        Cells.AutoFilter
       Else: Cells.AutoFilter
       Worksheets(1).Columns(c).Hidden = True
       c = c + 1
    End If

    'If y > 0 Then
    'ActiveSheet.AutoFilter.Range.Offset(1).Copy
    '    Sheets("AGAINST").Activate
    '    Range("A" & k).Select
    '    Range("A" & k).Value = C11 & ") " & Against
    '    k = k + 2
    '    Range("A" & k).Select
    '    Range("A" & k).Value = "Beneficial owner:"
    '    k = k + 1
    '    Range("A" & k).Select
    '    ActiveSheet.Paste
    '    k = k + y
    '    Range("A" & k).Value = "Sum"
    '    k = k + 3
    '    Columns(3).EntireColumn.Delete
    '    Err.Clear
    '    Sheets(1).Activate
    '    Cells.AutoFilter
    '    'Columns(3).EntireColumn.Delete
    '    Worksheets(1).Columns(c).Hidden = True
    '    c = c + 1
    'Else: Cells.AutoFilter
    '    'Columns(3).EntireColumn.Delete
    '    Worksheets(1).Columns(c).Hidden = True
    '    c = c + 1
    'End If

    Next i

    Sheets(2).Activate
        For Each NumRange In Columns("B").SpecialCells(xlConstants, xlNumbers).Areas
            SumAddr = NumRange.Address(False, False)
            NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Formula = "=SUM(" & SumAddr & ")"
            c = NumRange.Count
        Next NumRange
    NoData:
    'Sheets(2).Select
    Columns("A:B").AutoFit
    Sheets(1).Activate

    Cells.EntireColumn.Hidden = False
    Application.ScreenUpdating = True

End Sub

它可以很好地过滤和移动数据。但是当我尝试激活这部分

'    Range("A" & j).Font.Bold = True
'    Range("A" & j).Font.Underline = True

它给了我这个错误
运行时错误“1004”:
Range 类的 PasteSpecial 方法失败。事实上，如果我尝试在粘贴之前激活任何样式更改，我会收到此错误。
并突出这个区域

 Sheets(2).Range("A" & j).PasteSpecial

我就是不明白。

Answer 1

在 .Copy 方法之后，您需要立即粘贴结果。做任何其他事情都会清空复制缓冲区，所以这将起作用:

ActiveSheet.Range("A1").Copy
ActiveSheet.Range("A2").PasteSpecial
ActiveSheet.Range("A1").Font.Size = 10

但这不会

ActiveSheet.Range("A1").Copy
ActiveSheet.Range("A1").Font.Size = 10
ActiveSheet.Range("A2").PasteSpecial