Excel 复制数据范围，但忽略（不复制）带有公式的单元格

我有一份包含多张表格和公式的预算工作表。用户可以将其数据输入分类账，并自动计算各种财务方案。分类账包含一些包含公式的单元格，用户可能会重写这些单元格。这很好，因为工作表每月都在预测，必须使用实际条目进行更新，以保持预测的准确性

我偶尔会更新/升级预算工作表，希望用户能够从旧工作表导出数据并将其导入新工作表。我创建了一个宏，用于导出特定范围的数据。我还创建了一个宏，用于将数据范围导入新工作表

但是，我的问题是，要导出的宏还将预定计算从原始公式=A1+B2转换为公式$1200的结果。这会给其他数据范围内的未来预测带来问题，因为该公式现在被一个静态数字所取代，该数字不能根据其他月度存款/取款进行更改

我尝试导出数据减去任何包含公式的单元格，但没有成功。我已附上我的工作出口代码，因为我有许多表和范围，我只张贴了最低限度，以显示我的工作。我还附上了我用来忽略单元格的代码，这些公式是从这篇文章中得到启发的。 非常感谢您的帮助。显然，我对VBA还不熟悉，对它几乎一无所知

工作出口代码：

Sub GenerateData()
Dim strFile As String
'New workbook with 3 sheets
Workbooks.Add xlWBATWorksheet
ActiveSheet.Name = "Financial Info"
Sheets.Add(After:=Sheets(1)).Name = "HELOC"
Sheets.Add(After:=Sheets(2)).Name = "Accelerated Mortgage"
Sheets.Add(After:=Sheets(3)).Name = "Accelerated 2nd Loan"
ActiveWorkbook.Sheets("Financial Info").Range("G6:G8").Value = ThisWorkbook.Sheets("Financial Info").Range("G6:G8").Value
ActiveWorkbook.Sheets("Financial Info").Range("G11:G13").Value = ThisWorkbook.Sheets("Financial Info").Range("G11:G13").Value
ActiveWorkbook.Sheets("HELOC").Range("D13:F74").Value = ThisWorkbook.Sheets("HELOC").Range("D13:F74").Value
ActiveWorkbook.Sheets("HELOC").Range("D86:F147").Value = ThisWorkbook.Sheets("HELOC").Range("D86:F147").Value
End Sub

非工作：忽略带有公式的单元格

Sub example()
Dim source As Range
Dim target As Range
Set source = ActiveWorkbook.Sheets("HELOC").Range("D13:F877")
Set target = ThisWorkbook.Sheets("HELOC").Range("D13:F877")
copy_non_formulas source:=source, target:=target
copy_non_formulas source:=Range("D13:F74"), target:=Range("D13:F74")
copy_non_formulas source:=Range("D86:F147"), target:=Range("D86:F147")
End Sub

Public Sub copy_non_formulas(source As Range, target As Range)
'Assumes that all formulas start with '=' and all non formulas do not
Dim i As Long
Dim j As Long
Dim c As Range
For i = 1 To source.Rows.Count
    For j = 1 To source.Columns.Count
        Set c = source(RowIndex:=i, ColumnIndex:=j)
        If Left(c.Formula, 1) <> "=" Then
            target(RowIndex:=i, ColumnIndex:=j).Value = c.Value
        End If
    Next j
Next i
End Sub

---

我试过你的代码，它似乎工作得很好。它是如何失败的，基于什么数据

实际上，您正在从一个范围复制值并将它们粘贴到同一个范围，因此无法知道它是否有效。尝试更新这些行，将源和目标设置为不同的范围。例如，相反

copy_non_formulas source:=Range("D13:F74"), target:=Range("D13:F74")
copy_non_formulas source:=Range("D86:F147"), target:=Range("D86:F147")

你可以试试

copy_non_formulas source:=Sheets(1).Range("D13:F74"), target:=Sheets(2).Range("D13:F74")
copy_non_formulas source:=Sheets(1).Range("D86:F147"), target:=Sheets(2).Range("D86:F147")

---

下面是一个简单的子例程，它只将常量值从Sheet1移动到新工作簿

这应该是简单的编辑这对你的要求，但让我知道如果你有任何问题

Sub CopyWithoutFormulas()
    Dim newWorkbook As Workbook
    Set newWorkbook = Workbooks.Add

    Dim formulas As Range
    On Error Resume Next
    Set formulas = Sheet1.UsedRange.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0

    If formulas Is Nothing Then
        'no formulas so move all values across in one batch
        newWorkbook.Worksheets(1).Range(Sheet1.UsedRange.Address).Value = Sheet1.UsedRange.Value
    Else
        'formulas found so only move constants across
        Dim r As Range
        For Each r In Sheet1.UsedRange
            If Intersect(r, formulas) Is Nothing Then
                newWorkbook.Worksheets(1).Range(r.Address).Value = r.Value
            End If
        Next
    End If
End Sub

---

我尝试了这个网站上的一些建议，还有其他一些建议，但是由于我不确定如何首先编写代码，所以我一事无成。作为记录，我发布的代码是我从一个在线源代码中调整的，它完全符合我的要求…除了它用公式复制单元格。工作代码使用相同的选项卡创建新工作簿，并将数据导出到相应的相同单元格。现在，如果我可以编辑我现有的工作代码，以消除公式单元格的复制，那该多好啊？此处为完整工作代码减去所有图纸/数据范围后的参考

Sub GenerateData()
Dim strFile As String
'New workbook with 3 sheets
Workbooks.Add xlWBATWorksheet
ActiveSheet.Name = "Financial Info"
Sheets.Add(After:=Sheets(1)).Name = "HELOC"
Sheets.Add(After:=Sheets(2)).Name = "Accelerated Mortgage"
Sheets.Add(After:=Sheets(3)).Name = "Accelerated 2nd Loan"

ActiveWorkbook.Sheets("Financial Info").Range("G6:G8").Value = ThisWorkbook.Sheets("Financial Info").Range("G6:G8").Value
ActiveWorkbook.Sheets("Financial Info").Range("G11:G13").Value = ThisWorkbook.Sheets("Financial Info").Range("G11:G13").Value

ActiveWorkbook.Sheets("HELOC").Range("D13:F74").Value = ThisWorkbook.Sheets("HELOC").Range("D13:F74").Value
ActiveWorkbook.Sheets("HELOC").Range("D86:F147").Value = ThisWorkbook.Sheets("HELOC").Range("D86:F147").Value

ActiveWorkbook.SaveAs "Exported Data.xlsx"

End Sub

---

它失败了，可能是因为我真的不知道自己在做什么：我曾尝试将第二个代码合并到第一个代码中……但在看到它发布在这里之后，现在我想知道是否应该将每个部分单独编码。当我有更多的时间时，我会再试一次，然后回来汇报……可能不会持续一天或两天。谢谢你的建议。我会在有时间的时候试试，一两天后再报告。