Question

以下是我收到的错误消息：

运行时错误'1004' 无法运行宏'Do_Special_Copy'。宏可能在此工作簿中不可用，或者可能禁用所有宏。

我有三个具有相似字段的工作表，我想合并到另一个名为macro的工作表中，下面是宏的代码：

Sub Data_Consol()

End Sub

Sub WBLoop()

 Dim wb As Workbook, x As String
 For Each wb In Workbooks
    If wb.Name <> "Macro template" Then
         x = wb.Name
         Workbooks(x).Activate
    End If
    Call Copy_Paste
 Next wb

 ActiveCell.Offset(0, 1).Select

 Range(Selection, Selection.End(xlUp)).Select

Selection.Offset(1, 0).Select

Range(ActiveCell, ActiveCell.End(xlToLeft)).Select

Range(Selection, Selection.End(xlDown)).Select

Selection.EntireRow.Delete

Range("A1").Activate

Sheets("Template").Select
Sheets("AddFormulae").Visible = True

Sheets("AddFormulae").Select
Range("X2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.Run "Do_Special_Copy"
Sheets("Template").Select
Range("X2").Select
ActiveSheet.Paste
Columns("X:AD").Select
Columns("X:AD").EntireColumn.AutoFit

Sheets("Template").Select
Sheets("AddFormulae").Visible = False

Range("A1").Select

End Sub

Sub Copy_Paste()
Dim wb As Workbook
 Range("A2").Select
 Range(Selection, Selection.End(xlDown)).Select

' Select

Application.Run "Do_Special_Copy"
Windows("Macro template.xlsm").Activate

' Need to add in code here to find first empty row

ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).Select

ActiveSheet.Paste

Selection.End(xlDown).Select
Rows(ActiveCell.Row).EntireRow.Delete
ActiveWindow.SmallScroll Down:=3

End Sub

Sub SelectWorkbook()
'
' SelectWorkbook Macro
'
Windows("ESMS CTSM Q - Call Back.xlsx").Activate
End Sub

Answer 1

之前我遇到了同样的错误，并且对表单进行了解除保护（尝试取消保护工作表，如果受到保护，则尝试粘贴数据）。

运行时错误'1004'

1 个答案: