当我尝试删除行时，运行时错误1004

我一直在Office 2003上使用类似的代码，但最近升级到Office 2010并且代码已停止工作。当代码尝试删除由nStart和nEnd指定的行时，我一直在遍历代码并发生错误。我得到了一个运行时错误1004.我搜索了论坛，但我找不到解决方案。问题出现在最后几行代码中。当我尝试删除行时，运行时错误1004

该代码旨在复制大型数据集中的数据，并将其分解为组织内每个董事会的独立电子表格。一旦第一组已被复制跨数据从主表中删除，该过程开始，直到它遇到一个空的单元格。

我已经在解决这个问题上留下了一些尝试，但为了防止我接近，将它们转换为注释。

任何帮助，非常感谢。

Option Explicit 
Sub Appraisal_Split() 

Dim wbI As Workbook, wbO As Workbook 
Dim wsI As Worksheet, wsO1 As Worksheet 
Dim wsO2 As Worksheet 
Dim nRow As Long 
Dim nStart As Long, nEnd As Long 
Dim Dir As String 

'Stop screen from flickering 
Application.ScreenUpdating = False 

'~~> Source/Input Workbook 
Set wbI = ThisWorkbook 
'~~> Source/Input Sheet 
Set wsI = wbI.Sheets("Individual Data") 

' Define what directorate to search for. 

Do While Cells(2, 1).Value <> "" 
Dir = ActiveSheet.Cells(2, "A").Value 

' Find where Directorate data starts. 
For nRow = 1 To 10000 
If Range("A" & nRow).Value = Dir Then 
nStart = nRow 
Exit For 
End If 
Next nRow 

' Find where the Directorate data ends. 
For nRow = nStart To 10000 
If Range("A" & nRow).Value <> Dir Then 
nEnd = nRow 
Exit For 
End If 
Next nRow 
nEnd = nEnd - 1 

'~~> Destination/Output Workbook 
Workbooks.Open ("G:\Workforce\Reports\Weekly & Monthly & Quarterly Reports\Appraisal Reports\Appraisal Macro\Department Template.xlsx") 

Set wbO = Workbooks("Department Template.xlsx") 

With wbO 
    '~~> Set the relevant sheet to where you want to paste 
    Set wsO1 = wbO.Sheets("Data") 

    '~~>. Save the file 
    .SaveAs Filename:="G:\Workforce\Reports\Weekly & Monthly & Quarterly Reports\Appraisal Reports\Appraisal Macro\Temp" & "\" & Dir 

    '~~> Copy the range 
    wsI.Range("A" & nStart & ":I" & nEnd).Copy 

    '~~> Paste it data to Cell A1 of new workbook. 
    wsO1.Range("A2").PasteSpecial xlPasteFormats 
    wsO1.Range("A2").PasteSpecial xlPasteValues 
    wsO1.Range("A2").AutoFilter 

    ' Copy the column width for the first 9 columns 
     Dim i As Integer 
      For i = 1 To 9 
      wsO1.Columns(i).ColumnWidth = wsI.Columns(i).ColumnWidth 
     Next i 

    ' Update Summary Pivot Table 
     Set wsO2 = wbO.Sheets("Summary") 
     wsO2.PivotTables("PivotTable1").RefreshTable 

    '~~> Summary Formulas 
     wsO2.Range("F4:J4").Select 

     Dim LR As Long 

     LR = Range("A" & Rows.Count).End(xlUp).Row 
     Range("F4:J4").AutoFill Destination:=Range("F4:J" & LR) 

     Columns("B:F").EntireColumn.Hidden = True 
     Rows("2:3").EntireRow.Hidden = True 

    ' Set workbook protection, save and close. 
    wsO1.Protect Password:="workforce1", DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowFiltering:=True 
    wsO1.EnableSelection = xlNoRestrictions 
    wsO2.Protect Password:="workforce1", DrawingObjects:=False, Contents:=True,  Scenarios:=True, AllowFiltering:=True 
    wsO2.EnableSelection = xlNoRestrictions 
    wbO.Close savechanges:=True 
End With 

**' Delete directorate data from input file 
wsI.Rows(nStart, nEnd).Delete 
    ' .Rows(nStart & ":" & nEnd).EntireRow.Delete Shift:=xlUp 
    ' .Range(nStart, nEnd).EntireRow.Delete** 


' Workbooks("Trust Template with Macro.xls").Activate 
Loop 

End Sub

来源

2013-10-30 Marc

假设n开始和NEND是有效的：

wsI.Range(nStart & ":" & nEnd).Delete

来源

2013-10-30 17:08:55

您的您要删除的范围格式不正确。智能感知帮助可能有助于查看问题。但尝试的其中一种的变化，这取决于你是否要删除整个行，或者你的数据就位于该地区：

With wsI 
    .Range(.Cells(nStart, 1), .Cells(nEnd, 1)).EntireRow.Delete 
End With

或

With wsI 
    .Range(.Cells(nStart, "A"), .Cells(nEnd, "C")).Delete shift:=xlUp 
End With

来源

2013-10-30 17:12:30

谢谢两位，你就输回来，我已经尝试了所有答案，没有运气。为了使这个变量有效，我使用MsgBox nStart和MsgBox nEnd，输出了正确的值。我也试着选择使用范围：wsI.Range（“A”＆nStart＆“：I”＆nEnd）。选择哪一个也可以。所以看起来唯一会产生错误的是.Delete。 – Marc

复制并粘贴（不要输入），以便我可以清楚地看到你如何使用我的任何建议;还有nStart和nEnd正在返回的值。 –

另一个想法：工作表是否受到保护？ –

当我尝试删除行时，运行时错误1004

回答

相关问题