组合两个 VBA 代码位

Question

我必须做我想做的事的代码。 第一位，基于主控选项卡创建新工作表，并从中填充数据。 第二个查找数据的最后一行，并在 L 列到 AJ 列中的第一个空单元格处添加一个求和公式。 我一直在尝试将它们组合在一起，以便它从一个宏上运行。因此，当填充新工作表时，它还运行求和公式。 将不胜感激任何帮助。

创建新工作表并填充：

Option Explicit
Sub SheetsFromTemplate()
'Create copies of a template sheet using text on a master sheet in a specific column
'Sheetname strings are corrected using the UDF below
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
Dim shNAMES As Range, NM As Range, NmSTR As String, NR As Long
With ThisWorkbook                                               'keep focus in this workbook
    Set wsTEMP = .Sheets("Template")                            'sheet to be copied
    wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)              'check if it's hidden or not
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible      'make it visible
    Set wsMASTER = .Sheets("Master")                            'sheet with names
                                                                'range to find names to be checked
    Set shNAMES = wsMASTER.Range("A2:A" & Rows.Count).SpecialCells(xlFormulas)     'or xlFormulas
    Application.ScreenUpdating = False                          'speed up macro
    For Each NM In shNAMES                                      'check one name at a time
        NmSTR = FixStringForSheetName(CStr(NM.Text))            'use UDF to create a legal sheetname
        If Not Evaluate("ISREF('" & NmSTR & "'!A1)") Then       'if sheet does not exist...
            wsTEMP.Copy After:=.Sheets(.Sheets.Count)           '...create it from template
            ActiveSheet.Name = NmSTR                            '...rename it
        End If
        With .Sheets(NmSTR)
            NR = .Range("B" & .Rows.Count).End(xlUp).Offset(1).Row
            wsMASTER.Range("B1:B1").Copy
            .Range("A" & NR).PasteSpecial xlPasteValues, Transpose:=True
            NM.Resize(, 500).Copy .Range("A" & NR)
        End With
    Next NM
    wsMASTER.Activate                                           'return to the master sheet
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden       'hide the template if necessary
    Application.ScreenUpdating = True                           'update screen one time at the end
End With
MsgBox "All sheets created"
End Sub

Function FixStringForSheetName(shSTR As String) As String
'replace each forbidden character with something acceptable
    shSTR = Replace(shSTR, ":", "")
    shSTR = Replace(shSTR, "?", "")
    shSTR = Replace(shSTR, "*", "")
    shSTR = Replace(shSTR, "/", "-")
    shSTR = Replace(shSTR, "", "-")
    shSTR = Replace(shSTR, "[", "(")
    shSTR = Replace(shSTR, "]", ")")
'sheet names can only be 31 characters
    FixStringForSheetName = Trim(Left(shSTR, 31))
End Function

将求和公式添加到最后一行：

Option Explicit
Sub SubUntilLastRow()
Dim CurCal As XlCalculation
Dim wb As Workbook, ws As Worksheet, colsLastRow As Long
Dim cols As Variant, SumCols As Long, colsArray As Variant
Dim biggestRow As Long
Dim shNAMES As Range
With ThisWorkbook
    Application.ScreenUpdating = False
    CurCal = Application.Calculation
    Application.Calculation = xlCalculationManual
    biggestRow = 1
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("CPB - NAM")
    colsArray = Array("L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ")
    For Each cols In colsArray
    colsLastRow = ws.Cells(Rows.Count, cols).End(xlUp).Row
    If colsLastRow > biggestRow Then
    biggestRow = colsLastRow + 1
    End If
    Next cols
    For Each cols In colsArray
    colsLastRow = ws.Cells(Rows.Count, cols).End(xlUp).Row
    ws.Cells(biggestRow, cols).Formula = "=SUM(" & cols & "9:" & cols & colsLastRow & ")"
    Next cols
    ws.Range("B" & biggestRow).Value = "TOTAL"
    Application.ScreenUpdating = True
    Application.Calculation = CurCal
End With
End Sub

Answer 1

首先，你转换你的 Sub

Sub SubUntilLastRow()

变成一个以工作表为参数的函数

Function SubUntilLastRow(ws As Worksheet)

删除以下代码行：

Set wb = ThisWorkbook
Set ws = wb.Sheets("CPB - NAM")

在For Each NM In shNAMES循环中，您将线条放在底部 SubUntilLastRow(NM(

调用对应工作表的函数