簡體   English   中英

當我嘗試刪除行時出現運行時錯誤1004

[英]Run-time Error 1004 when I try to delete rows

我在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

假設nStart和nEnd有效:

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

您要刪除的范圍的格式不正確。 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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM