跨工作表复制公式范围

Question

我有一系列公式需要在所有工作表中复制。范围从 AB1:AC5 开始。公式需要跨工作表工作，并取自名为“模板”的工作表，该工作表是工作簿中的第一个工作表。我相信我已经选择了范围，它将继续只从“模板”复制。我怎样才能让它粘贴到其他每张纸上？

Sub FillSheets()
 Dim sh As Worksheet
 Dim rng As Range

 Dim worksheetsToSkip As Variant

 worksheetsToSkip = Array("Aggregated", "Collated Results", "Template", "End")
 Set rng = Sheet1.Range("AB1:AC5")

 For Each ws In Worksheets
    If IsError(Application.Match(ws.Name, worksheetsToSkip, 0)) Then


End Sub

Answer 1

您已经很接近了，因为您必须使用 Range 对象的 Formula 属性和对“源”范围 Address 的引用

另外，你有一个变量名不匹配：声明了sh As Worksheet，但你使用了ws

试试这个：

Sub FillSheets()
    Dim sh As Worksheet
    Dim rng As Range

    Dim worksheetsToSkip As Variant

    worksheetsToSkip = Array("Aggregated", "Collated Results", "Template", "End")
    Set rng = Sheet1.Range("AB1:AC5")

    For Each sh In Worksheets
       If IsError(Application.Match(sh.Name, worksheetsToSkip, 0)) Then sh.Range(rng.Address).Formula = rng.Formula
    Next
End Sub

Answer 2

感叹号问题

包含工作表引用的单元格

有一个名为Template 的工作表。您可以将公式=A2+A3 写入单元格A1。你也可以写=Template!A2+A3或=Template!A2+Template!A3。在所有三种情况下，结果都是相同的。但是，当您将Paste Special 公式放入另一张表时，您会在每种情况下得到不同的公式，因此可能会得到不同的结果。此代码通过仅粘贴第一个场景 (=A2+A3) 消除了这种可能性。

Excel 何时将这些工作表引用写入工作表？

在我们的示例中，=Template!A2+A3 的情况可能发生在选择 Template 选项卡时，在公式栏中输入等号 (=)，单击不同的选项卡，然后单击 Template 选项卡被点击，A2+A3被输入，ENTER被按下。
=Template!A2+Template!A3 的情况可能发生在选择 Template 选项卡时，在公式栏中输入等号 (=)，单击不同的选项卡，然后单击 Template 选项卡，A2被选中，再次单击不同的选项卡，输入 (+)，再次单击 Template 选项卡，A3 被选中并按下 ENTER。

Option Explicit

'*******************************************************************************
' Purpose:  Pastes formulas from a range in an initial worksheet               *
'           to the same range in all worksheets that are not included          *
'           in a specified worksheet-names list of exceptions.                 *
' Remarks:  There has to be a worksheet with the codename "Sheet1"             *
'           in the workbook in which this code resides or it will not compile. *
'*******************************************************************************
Sub FillSheetsWithRangeOfFormulas()

  Const cStrRange = "AB1:AC5"                         ' Initial Range Address
  Const cStrSkip = "Aggregated,Collated Results,End"  ' List of Exceptions
  Const cStrSkipSeparator = ","                       ' List of Exceptions Sep.

  Dim objWs As Worksheet      ' Worksheet Object to be Used in a For Each Loop
  Dim vntSkip As Variant      ' List of Exceptions Array
  Dim vntFormulas As Variant  ' Formulas Array
  Dim lngRows As Long         ' Formulas Array Rows Counter
  Dim intColumns As Integer   ' Formulas Array Columns Counter
  Dim vntWb As Variant        ' Workbooks Array
  Dim intWb As Integer        ' Workbooks Array Rows Counter
  Dim strDel As String        ' Worksheet Reference String ("!" & Sheet1.Name)
  Dim strWb As String         ' Workbooks Array Split String ("]" & strDel)
  Dim strWbTemp As String     ' Workbooks Array Temporary String ("" or strWb)
  Dim strWbResult As String   ' Workbooks Array Resulting String

  With Sheet1
    ' Paste Initial-Range formulas into (1-based 2-dimensional) Formulas Array.
    vntFormulas = .Range(cStrRange).Formula
    ' Define Worksheet Decalaration String
    strDel = .Name & "!"
  End With

  ' Define Workbooks Array Split String to use to not remove worksheet
  ' references to sheets with the same name as Sheet1 in other workbooks.
  strWb = "]" & strDel

  ' Remove worksheet(!) references from formulas in Formulas Array.

  ' In the following For-Next loop, in the comments, "Template" for Sheet1's
  ' name is used.

  For intColumns = LBound(vntFormulas, 2) To UBound(vntFormulas, 2)
    For lngRows = LBound(vntFormulas) To UBound(vntFormulas)

      ' Check if element does not contain "]Template!" which would indicate that
      ' it is linking to a sheet with the same name in another workbook.
      If InStr(1, vntFormulas(lngRows, intColumns), strWb, _
          vbTextCompare) = 0 Then   ' Does NOT contain "]Template!" (strWb).

        ' Check if element contains just "Template!" (strDel).
        If InStr(1, vntFormulas(lngRows, intColumns), strDel, _
            vbTextCompare) <> 0 Then    ' DOES contain "Template!" (strDel).
          ' Write resulting string to Formulas Array (overwriting).
          vntFormulas(lngRows, intColumns) = Replace(vntFormulas(lngRows, _
              intColumns), strDel, "", , , vbTextCompare)
'         Else                          ' Does NOT contain "Template!" (strDel).
        End If

       Else                         ' DOES contain "]Template!" (strWb).

        strWbResult = ""
        ' Split the element's string by "]Template!" (strWb) into a 0-based
        ' 1-dimensional array.
        vntWb = Split(vntFormulas(lngRows, intColumns), strWb, , vbTextCompare)
        ' Rebuild the string removing additional "Template!" (strDel) strings.
        For intWb = LBound(vntWb) To UBound(vntWb)
          If intWb <> 0 Then ' Is NOT first element of array.
            strWbTemp = strWb
           Else              ' IS first element of array.
            strWbTemp = ""
          End If
          ' Check if element contains just "Template!" (strDel).
          If InStr(1, vntWb(intWb), strDel, _
              vbTextCompare) <> 0 Then  ' DOES contain "Template!" (strDel).
            strWbResult = strWbResult & strWbTemp & Replace(vntWb(intWb), _
                strDel, "", , , vbTextCompare)
           Else                         ' Does NOT contain "Template!" (strDel).
            strWbResult = strWbResult & strWbTemp & vntWb(intWb)
          End If
        Next
        Erase vntWb
        ' Write resulting string to Formulas Array (overwriting).
        vntFormulas(lngRows, intColumns) = strWbResult

      End If

    Next
  Next

  With Sheet1
    ' Populate (0-based 1 dimensional) List of Exceptions Array (vntSkip),
    ' after adding Sheet1's name (.Name i.e. Sheet1.Name).
    vntSkip = Split(cStrSkip & cStrSkipSeparator & .Name, cStrSkipSeparator)
    ' Paste Formulas Array (vntFormulas) into the range (same size and position
    ' as the Initial Range (cStrRange)) of each worksheet whose name is not
    ' contained in the List of Exceptions (vntSkip) in the workbook
    ' (.Parent.Name i.e. Sheet1.Parent.Name) where Sheet1 resides.
    For Each objWs In Workbooks(.Parent.Name).Worksheets
      If IsError(Application.Match(objWs.Name, vntSkip, 0)) Then _
          objWs.Range(cStrRange).Formula = vntFormulas
    Next
  End With

  Erase vntSkip
  Erase vntFormulas

End Sub
'*******************************************************************************