将主文件的最后一行复制到多个创建的工作表，然后在最后一行的列中执行小计公式答案

【问题标题】：copy lastrow of masterfile to multiple created worksheets then perform a Subtotal formula in a column lastrow将主文件的最后一行复制到多个创建的工作表，然后在最后一行的列中执行小计公式
【发布时间】：2017-04-08 04:57:45
【问题描述】：

我有一个主文件（JV501），我在其中过滤 AB 列（货币），然后将它们复制到 createdsheets，我现在的问题是主文件的最后一行，我需要将它包含到每个创建的工作表中，因为它开始于R 列和 AD 列（全为空）下的 lastrow 是我将执行 AC2 小计的地方，直到 lastrow，因此小计应与复制的 lastrow 内联。

Option Explicit

Sub SortCurrency()
    Dim currRng As Range, dataRng As Range, currCell As Range
    Dim LastCol As Long, lastRow As Long, lastrow2 As Long, TheLastRow As Long

    Call DeleteSheets

    With Worksheets("JV501")
        Set currRng = .Range("AB1", .Cells(.Rows.Count, "AB").End(xlUp))
        Set dataRng = Intersect(.UsedRange, currRng.EntireRow)

        LastCol = Range("A1").End(xlToRight).Column
        TheLastRow = Range("A1").End(xlDown).Row
        lastRow = Range("AB2").End(xlDown).Row
        Range("AB2:AB" & lastRow).sort key1:=Range("AB2" & lastRow), _
        order1:=xlAscending, Header:=xlNo
        Range("AF:XFD").EntireColumn.Delete

        With .UsedRange
            With .Resize(1, 1).Offset(, .Columns.Count)
                With .Resize(currRng.Rows.Count)
                    .Value = currRng.Value
                    .RemoveDuplicates Array(1), Header:=xlYes
                    For Each currCell In .SpecialCells(xlCellTypeConstants)
                        currRng.AutoFilter field:=1, Criteria1:=currCell.Value
                        If Application.WorksheetFunction.Subtotal(103, currRng) - 1 > 0 Then
                            dataRng.SpecialCells(xlCellTypeVisible).Copy Destination:=GetOrCreateWorksheet(currCell.Value).Range("A1")
                            Range("J:Q").EntireColumn.Delete
                            Range("A:A").EntireColumn.Delete
                            Columns("A:AE").Select
                            Selection.EntireColumn.AutoFit

                        End If
                    Next currCell
                    .ClearContents

                End With
            End With
        End With
        .AutoFilterMode = False
    End With
    Call checklist
End Sub
Function GetOrCreateWorksheet(shtName As String) As Worksheet
    On Error Resume Next
    Set GetOrCreateWorksheet = Worksheets(shtName)
    If GetOrCreateWorksheet Is Nothing Then
        Set GetOrCreateWorksheet = Worksheets.Add(After:=Sheets(Sheets.Count))
        GetOrCreateWorksheet.Name = shtName
    End If
End Function

到目前为止，这是我的代码。我很困惑我该怎么做。感谢您的每一次帮助！

【问题讨论】：

标签： vba excel loops excel-formula

【解决方案1】：

在尝试计算一列范围时，我想出了并通过在创建工作表的循环中添加它来使其工作。

 'subtotal of debit
                            lastrowSrc = Range("AC" & Rows.Count).End(xlUp).Row + 1
                            Range("AC" & lastrowSrc & ":AC" & lastrowSrc).Formula = "=SUBTOTAL(9,AC2:AC" & lastrowSrc - 1 & ")"

                            'copy ac to ad
                            Range("AC" & lastrowSrc & ":AC" & lastrowSrc).Cut Destination:=Range("AC" & lastrowSrc).Offset(0, 1)

在 AC 列中，我将计算借方的小计，然后将其复制到另一个为空的 AD 列，我已将其粘贴到 AC 列然后偏移

为了复制未包含在提取标准中的列，我已经一一完成了

dim internalS as long, 'and so on
 internalR = Range("R" & Rows.Count).End(xlUp).Row + 1
                            copyR.Copy Destination:=Range("R" & internalR)

                            internalS = Range("S" & Rows.Count).End(xlUp).Row + 1
                            copyS.Copy Destination:=Range("S" & internalS)

                            internalT = Range("T" & Rows.Count).End(xlUp).Row + 1
                            copyT.Copy Destination:=Range("T" & internalT)

                            internalU = Range("U" & Rows.Count).End(xlUp).Row + 1
                            copyU.Copy Destination:=Range("U" & internalU)

                            internalV = Range("V" & Rows.Count).End(xlUp).Row + 1
                            copyV.Copy Destination:=Range("V" & internalV)

                            internalW = Range("W" & Rows.Count).End(xlUp).Row + 1
                            copyW.Copy Destination:=Range("W" & internalW)

                            internalX = Range("X" & Rows.Count).End(xlUp).Row + 1
                            copyX.Copy Destination:=Range("X" & internalX)

                            internalY = Range("Y" & Rows.Count).End(xlUp).Row + 1
                            copyY.Copy Destination:=Range("Y" & internalY)

                            internalZ = Range("Z" & Rows.Count).End(xlUp).Row + 1
                            copyZ.Copy Destination:=Range("Z" & internalZ)

                            internalAE = Range("AE" & Rows.Count).End(xlUp).Row + 1
                            copyAE.Copy Destination:=Range("AE" & internalAE)

在创建新工作表时也将其插入到我的循环中

【讨论】：