从功能区运行工作宏时出错

以下是VBA中Excel2010的宏。它只在打开VBA代码编辑器并从Debug菜单运行时才起作用。我试图把它放到丝带，并从那里运行它，但我得到这个错误：从功能区运行工作宏时出错

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

此外，当我改变所有Range()到.Worksheet(i).Range()，程序不相同的错误运行在所有。它就像.Range似乎不属于Worksheet（i）的一部分。我在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

编辑：确定。我稍微改变了代码，希望我错误地提到了正确的表单等问题仍然存在。该行： ActiveSheet.Range(rg1, rg1) = "=IF(RC[-6]=0,"""",RC[-6] + R4C5"导致该问题。令人惊讶的是，我并不是第一次在活动工作表中提及Range，出于某些原因，我真的不知道为什么，我有错误！要穷尽所有可能性，我也尝试这些：在VBA窗口

明确重新创建一个模块
重新打开该文件
录制宏，并在那里

插入代码

到目前为止没有任何工作。我已经放弃了，但也许以后有人会看到这个问题，并在这里给出一个解决方案。

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

来源

2014-09-24 Celdor

尝试使用ThisWorkbook将引用原始工作簿而不是ActiveWorkbook – duDE 2014-09-24 13:22:06

我已经对其进行了更改。我没有注意到其中的差异。错误仍然存在。还有一些我还不知道的东西，我尝试确定问题出在哪里，但我在Excel VBA中没有太多经验。 Stack Exchange是Q/A网站。我在这里没有做错任何事！我不知道为什么我收到-2。我已经问过这个问题，并给出了这个例子。 – Celdor 2014-09-24 17:26:10

我不知道你为什么得到-2，无论如何，从我+1作为一个小安慰:) – duDE 2014-09-24 17:32:18

尝试以下方法：

Sub CopyAndRearrange(Control as IRibbionControl)

添加控制允许从RIBBION执行的代码。

来源

2014-09-24 19:42:09 mongoose36

这不仅仅是。当我今天重新打开文件时，它无法完全运行。 – Celdor 2014-09-25 07:51:26

我想我找到了自己的问题的答案。

的问题是缺少支架在这一行：

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

这应该是：

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

如果错误是更容易理解，我也不会失去2天寻找这个问题：/

来源

2014-09-25 10:35:52 Celdor

从功能区运行工作宏时出错

回答

相关问题