masterfileのlastrowを複数のワークシートにコピーし、lastrow列に小計式を実行します

Question

私は、ABファイル（通貨）をフィルタリングして作成したマスターファイル（JV501）を作成しました。私が作成したすべてのワークシートに含まれる必要があるマスターファイルからの最後の行は、列Rで始まり、そこから列AD（すべてがヌルです）からのもので、最後の部分はAC2の小計を最後まで実行します。ラストローがコピーされました。

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

列の範囲を計算しようとすると、これを私のループでシートを作成する際に追加することによって、それが機能しています。コラムACで

'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ことによってそれを貼り付けましたnullであるADである別の列にコピーします1

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) 

で、私はそれを1つずつやった抽出の基準に含まれても、新しいワークシート

を作成する際に、私のループでこれを挿入