Excel VBA-在空白单元格之前的列中求和

Question

我有带有位置和宏的Excel Offer Sheet ，当B列中的值不等于0时，该行将其从该工作表的行转移到第二个工作表。它还在单词“ SUMA”之后添加空行。

Option Explicit
Dim MyWorkbook As Workbook
Dim MyWorksheet As Worksheet
Dim MyOutputWorksheet As Worksheet

Sub PullData()
Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
Set MyWorksheet = MyWorkbook.Sheets("Roboczy")
Set MyOutputWorksheet = MyWorkbook.Sheets("Oferta")

    Dim myValue As Long
    Dim RowPointer As Long

    For RowPointer = 1 To MyWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
        If MyWorksheet.Range("B" & RowPointer).Value > 0 And MyWorksheet.Range("B" & RowPointer).Value <> "" Then
            If MyOutputWorksheet.Cells(Rows.Count, "B").End(xlUp).Row > 155 Then
                Exit Sub
            End If
            MyWorksheet.Range(("A" & RowPointer) & ":D" & RowPointer).Copy Destination:=MyOutputWorksheet.Range("A" & MyOutputWorksheet.Cells(Rows.Count, "B").End(xlUp).Row + 1)
        End If
    Next RowPointer


     Dim b As Range
For Each b In MyOutputWorksheet.Range("A1:A200")
 If b.Value Like "*SUMA*" Then
 b.Offset(1, 0).EntireRow.Insert
 End If
Next b

End Sub

我错过了一些可以清除#ADR的代码！ 并汇总每个部分中的所有单元格。 更多详细信息-> Excel工作表图像

Answer 1

这是纯粹的猜测，因为我看不到Roboczy工作表，但我认为您得到了我所说的#REF！ 错误。 可能是由于源工作表包含一个引用了转换为目标工作表时无效的范围的公式。 我能想到的最简单的解决方案是粘贴/特殊值而不是常规粘贴来删除公式：用以下内容替换一条粘贴行：

MyWorksheet.Range(("A" & RowPointer) & ":D" & RowPointer).Copy
MyOutputWorksheet.Range("A" & Cells(MyOutputWorksheet.Rows.Count, "B").End(xlUp).Row + 1).PasteSpecial xlPasteValues