运行时错误1004无法插入新的单元格，因为它会将非空的新单元格从工作表的末尾推出

我有一个工作得很好的VBA，直到我保存并再次打开它，运行它并开始得到错误。运行时错误1004无法插入新的单元格，因为它会将非空的新单元格从工作表的末尾推出

我从表格（“主”）复制数据并将此数据转换为表格（“全部”）。问题在于我将它转换为表格（标识为列表对象）并在粘贴发生之前添加新行。但是，由于某种原因，它会在表单的奇怪区域转置。有时在需要的地方，有时在Excel的最后一行。正因为如此，我会得到运行时间1004错误，我不得不进入数据找到这个随机单元。因为这不会被我使用，但它是一个模板工作簿，所以我需要确保它能够顺利运行。

这里是我使用

If Sheets("Master").Range("E3") <> "All Agents" Then 

Sheets("All").ListObjects("Table24").ListRows.Add 
    Sheets("Master").Range("E3").Copy 
    Sheets("All").Cells(Sheets("All").Range("A1").ListObject.DataBodyRange.Rows.Count + 1, 1).PasteSpecial (xlPasteValues) 
    Sheets("Master").Range("H3").Copy 
    Sheets("All").Cells(Sheets("All").Range("B1").ListObject.DataBodyRange.Rows.Count + 1, 2).PasteSpecial (xlPasteValues) 
    Sheets("Master").Range("F9:F33").SpecialCells(xlCellTypeVisible).Copy 
    Sheets("All").Cells(Sheets("All").ListObject.DataBodyRange.End(xlDown).Row, 3).PasteSpecial xlPasteValues, Transpose:=True

来源

2017-07-12 Yujinlove

尝试，因为代码，

Option Explicit 

Sub Macro1() 
    Dim wsm As Worksheet, i As Long, v As Long, vals As Variant 

    Set wsm = Worksheets("Master") 
    If LCase(wsm.Range("E3")) <> "all agents" Then 
     v = Application.Subtotal(103, wsm.Range("F9:F33")) 
     If CBool(v) Then 
      ReDim vals(1 To 1, 1 To v + 2) 
      vals(1, 1) = wsm.Range("E3").Value 
      vals(1, 2) = wsm.Range("H3").Value 
      For i = 1 To v 
       vals(1, i + 2) = wsm.Range("F9:F33").SpecialCells(xlCellTypeVisible)(i) 
      Next i 

      With Worksheets("All").ListObjects("Table24") 
       .ListRows.Add AlwaysInsert:=False 
       .DataBodyRange.Cells(.DataBodyRange.Rows.Count, 1).Resize(1, UBound(vals, 2)) = vals 
      End With 
     End If 
    End If 
End Sub

来源

2017-07-12 20:45:53 Jeeped

运行时错误1004无法插入新的单元格，因为它会将非空的新单元格从工作表的末尾推出

回答

相关问题