Excel VBA Paste error when applying style to cell

Question

I'm seeking some assistance. I have a code that does what I need and works pretty fine, but I want to make it do some more, and thats when it breaks. Here is the code, a bit messy I know:

    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

It filters and moves data just fine. But when i try to activate this part

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

It gives me this error Run-time error '1004': PasteSpecial method of Range class failed. In fact, if I try to activate any style change before the paste i get this error. And highlights this area

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

I just don't get.

Have you seen [How to avoid using Select in Excel VBA macros](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros)? — , Mar 18 '16 at 08:36
The code starts to do everything to both Abstain and Against then suddenly gives up and only works with Abstain. Are you trying to do the same thing to both or only half of the things to Against? — , Mar 18 '16 at 08:48
@Jeeped Thanks for the link I'll take a look at it. At first Macros should filter everything by Abstain then by Against. It works fine untill I try to make some cells Bold. Thats where it brakes. — Dzago, Mar 18 '16 at 09:10
@Jeeped Here's the sample file: [link](https://drive.google.com/file/d/0B7MUtMMUOTXgZEp5OUJqN2RIMkoxTWl4emJCRi1vR01KZFln/view?usp=docslist_api). Amount of items is variable, so thats what the input box is for. Whe it creates the second sheet Text "Beneficial owner and Number of shares" should be bold. But if I try to make it so the code breaks. — Dzago, Mar 18 '16 at 10:02

score 0 · Accepted Answer · answered Mar 18 '16 at 12:22

After the .Copy method you need to immediately paste the results. Doing anything else will empty the copy buffer, so this will work:

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

But this won't

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

Excel VBA Paste error when applying style to cell

1 Answers1