1

我一直在 Office 2003 上使用与此类似的代码，但我最近升级到 Office 2010 并且代码已停止工作。我一直在单步执行代码，当代码尝试删除由 nStart 和 nEnd 指定的行时，它会出错。我收到一个运行时错误 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
4

2 回答 2

1

假设 nStart 和 nEnd 有效：

wsI.Range(nStart & ":" & nEnd).Delete
于 2013-10-30T17:08:55.280 回答
0

您要删除的范围的格式不正确。Intellisense 帮助可能有助于查看问题。但请尝试其中一种变体，具体取决于您是要删除整行还是仅删除数据所在的区域：

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-30T17:12:30.313 回答