Celdor
Celdor

Reputation: 2597

Error when running a working macro from a Ribbon

Below is a macro for Excel2010 in VBA. It's working only when I open VBA Code editor and run from the menu Debug. I tried to put it to Ribbon and run it from there but I've got this error:

Run-time error '1004':
Application-defined or object-defined error

Additionally, when I change all Range() into .Worksheet(i).Range(), the procedure does not run at all with the same error. It's like .Range does not seem to be part of Worksheet(i). I have no experience in Excel 2010 VBA.

Sub CopyAndRearrange()
    Dim ns As Integer
    Dim i As Integer

    ns = ActiveWorkbook.Worksheets.Count
    ActiveWorkbook.Sheets(ns).Cells.ClearContents

    For i = 1 To ns - 1
        With ActiveWorkbook
            .Worksheets(i).Activate
            Range("E1") = CInt(.Worksheets(i).Name)
            Range(Range("G1"), Range("A1").End(xlDown).Offset(0, 7)) = "=IF(RC[-6]=0,"""",RC[-6] + R4C5"
            Range(Range("I1"), Range("A1").End(xlDown).Offset(0, 8)) = "=RC[-6]"

            Range(Range("G1"), Range("I1").End(xlDown)).Copy
            Sheets(ns).Activate
            If i = 1 Then
                'Range(Range("G1"), Range("I1").End(xlDown)).Copy Destination:=Sheets(ns).Range("A1")
                Sheets(ns).Range("A1").Select
            Else
                'Range(Range("G1"), Range("I1").End(xlDown)).Copy Destination:=Sheets(ns).Range("A1").End(xlDown).Offset(1, 0)
                Sheets(ns).Range("A1").End(xlDown).Offset(1, 0).Select
            End If
            ActiveSheet.Paste Link:=True
            Application.CutCopyMode = False
            Application.ScreenUpdating = True
        End With
    Next
    Sheets(ns).Range("A1").Select
End Sub



EDIT: OK. I have slightly changed the code in hope I was wrong about referring to the right sheet etc. The problem is still there. The line: ActiveSheet.Range(rg1, rg1) = "=IF(RC[-6]=0,"""",RC[-6] + R4C5" causes the problem. Surprisingly, it is not the first that I refer to Range in the an active sheet and for some reasons, I really don't know why, I've got the error!!! To exhaust all possibilities, I have also tried these:

Nothing's worked so far. I have given up but maybe someone in future will see the problem and give a solution here.

Public Sub CopyAndRearrange()
    Dim ns As Integer
    Dim i As Integer
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim rg1 As Range
    Dim rg2 As Range
    Dim cell As Range

    Set wb = ThisWorkbook
    ns = wb.Worksheets.Count
    wb.Sheets(ns).Cells.ClearContents

    For i = 1 To ns - 1
        With wb
            Set ws = wb.Worksheets(i)
            ws.Activate

            ActiveSheet.Range("E1") = CInt(ActiveSheet.Name)

            Set rg1 = ActiveSheet.Range("G1")
            Set rg2 = ActiveSheet.Range("A1").End(xlDown).Offset(0, 7)
            ActiveSheet.Range(rg1, rg1) = "=IF(RC[-6]=0,"""",RC[-6] + R4C5"

            Set rg1 = ActiveSheet.Range("I1")
            Set rg2 = ActiveSheet.Range("A1").End(xlDown).Offset(0, 8)
            ActiveSheet.Range(rg1, rg2) = "=RC[-6]"

            Set rg1 = ActiveSheet.Range("G1")
            Set rg2 = ActiveSheet.Range("I1").End(xlDown)
            ActiveSheet.Range(rg1, rg2).Copy

            Sheets(ns).Activate
            If i = 1 Then
                ActiveSheet.Range("A1").Select
            Else
                ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select
            End If
            ActiveSheet.Paste Link:=True
            Application.CutCopyMode = False
            Application.ScreenUpdating = True
        End With
    Next
    Sheets(ns).Range("A1").Select

    Set ws = Nothing
    Set wb = Nothing
    Set rg1 = Nothing
    Set rg2 = Nothing
    Set cell = Nothing
End Sub

Upvotes: 0

Views: 386

Answers (2)

Celdor
Celdor

Reputation: 2597

I guess I found the answer to my own question.

The problem was missing bracket in this line:

ActiveSheet.Range(rg1, rg1) = "=IF(RC[-6]=0,"""",RC[-6] + R4C5"

which should be:

ActiveSheet.Range(rg1, rg1) = "=IF(RC[-6]=0,"""",RC[-6] + R4C5)"

If the error was more intelligible, I would not lose 2 days to look for this problem :/

Upvotes: 0

mongoose36
mongoose36

Reputation: 799

Try the following:

Sub CopyAndRearrange(Control as IRibbionControl)

Adding the control allows the code to be executed from the ribbion.

Upvotes: 1

Related Questions