0

每个数据表都有一个标题行，第一行有许多公式。该代码应该首先删除除标题行和公式行之外的每个工作表中的数据。接下来，它从每张工作表的第一行复制公式，并根据从数据输入页面确定的行数将其粘贴。该代码适用于几百行数据，但我收到以下错误消息

“运行时错误 '-2147417848 (80010108)'：对象 'Range' 的方法 'PasteSpecial' 失败”

当有几千行数据时。这让我发疯，我不知道如何解决它

这是 VBA 代码：

Sub FillWithFormula1()
    Worksheets("CALCULATE").Unprotect "pass"
    Dim ws As Worksheet
    Dim lastRow As Long

    Application.ScreenUpdating = False
    lastRow = Worksheets("DATA ENTRY PAGE").Range("A" & Rows.Count).End(xlUp).Row
    For Each ws In Worksheets(Array("CALCULATE", "NUTRIENTSORT", "INSECT TYPE SORT", "FUNGUS GROUP SORT", "WEEDSORT", "BACTERIASORT", "VIRUSSORT", "NEMATODESORT", "MITESORT", "BIRDSORT", "MAMMALSORT", "PHYTOPLASMASORT", "FUNGUS", "BACTERIA", "NEMATODE", "VIRUS", "PHYTOPLASMA", "INSECT", "NUTRIENT", "WEED", "WATERMOULD", "BIRD", "MAMMAL", "MOLLUSC", "MITE", "OTHER", "UNKNOWN", "ENVIRONMENT", "aphid", "Fruitfly", "mealybug", "leafminer", "cricket", "mole cricket", "scale", "thrip", "stemborer", "beetles", "whitefly", "caterpillars", "cutworms", "termites", "rust", "smut", "botrytis", "powderymildew", "dampingoff", "bug", "jassid", "Mirid", "gallmidge", "weevil", "nitrogen", "phosphate", "potassium", "calcium", "boron", "Iron", "zinc", "molybdenum", "sulphur", "downymildew", "lateblight", "clubroot", "Bananaweevil", "FALLARMYWORM"))
        With ws
            .Range("A3:AN100000").ClearContents        
            .Range("A2:AN2").Copy            
             If lastRow = 1 Then                        
                 lastRow = lastRow + 1
             End If            
             .Range("A2:AN" & lastRow).PasteSpecial xlPasteFormulas
             .Range("A2:AN" & lastRow).PasteSpecial xlFormats    
        End With
    Next ws
    
    For Each Rng In Worksheets("CALCULATE").Range("A2:AM" & lastRow)
        If Rng.HasFormula Then
            Rng.Locked = True    
        Else
            Rng.Locked = False
        End If    
    Next Rng
    
    Worksheets("CALCULATE").Protect "pass", AllowFiltering:=True
    Application.ScreenUpdating = True
End Sub

错误在该行中：

.Range("A2:AN" & lastRow).PasteSpecial xlPasteFormulas
4

0 回答 0