Question

我有一个主文件是（JV501），我在那里过滤AB（货币）然后将它们复制到createdsheets，我现在的问题是来自主文件的lastrow我需要包含到每个创建的工作表中，因为它开始于列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

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

Answer 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)

还在我的循环中插入了这个以创建新的工作表

将masterfile的lastrow复制到多个创建的工作表，然后在lastrow

1 个答案: