I have this code that works well, but I need to include two formulas to calculate the total for decimal and integer numbers.
Code: Select all
Sub TransferColumns()
Const lngHeaderRowStart = 6
Const lngHeaderRowEnd = 7
Const lngFirstRow = 8
Const lngRowsPerPage = 25
Dim wshSource As Worksheet
Dim wshTarget As Worksheet
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
Dim lngLastRow As Long
Dim lngNumRows As Long
Dim lngNumPages As Long
Dim i As Long
Dim lngRow As Long
Application.Cursor = xlWait
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wshSource = Worksheets("MasterData") ' ******
With wshSource
lngLastRow = .Range("A:AW").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set rng1 = .Range("A" & lngFirstRow & ":A" & lngLastRow)
Set rng2 = .Range("D" & lngFirstRow & ":D" & lngLastRow)
Set rng3 = .Range("F" & lngFirstRow & ":F" & lngLastRow)
Set rng4 = .Range("AA" & lngFirstRow & ":AW" & lngLastRow)
End With
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Abstract").Delete ' ********
Application.DisplayAlerts = True
On Error GoTo 0
Set wshTarget = Worksheets.Add(After:=wshSource)
wshTarget.Name = "Abstract" ' **********
With wshSource
.Range("A" & lngHeaderRowStart & ":A" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("A" & lngHeaderRowStart)
.Range("D" & lngHeaderRowStart & ":D" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("B" & lngHeaderRowStart)
.Range("F" & lngHeaderRowStart & ":F" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("C" & lngHeaderRowStart)
.Range("AA" & lngHeaderRowStart & ":AW" & lngHeaderRowEnd).Copy Destination:=wshTarget.Range("D" & lngHeaderRowStart)
End With
With wshTarget.Range("A" & lngHeaderRowStart & ":Z" & lngHeaderRowEnd)
.Font.Name = "Arial"
.Font.Size = 12
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
With wshTarget
.Rows(lngHeaderRowStart).RowHeight = 80
.Rows(lngHeaderRowStart + 1).RowHeight = 30
End With
rng1.Copy Destination:=wshTarget.Cells(lngFirstRow, "A")
rng2.Copy Destination:=wshTarget.Cells(lngFirstRow, "B")
rng3.Copy Destination:=wshTarget.Cells(lngFirstRow, "C")
rng4.Copy Destination:=wshTarget.Cells(lngFirstRow, "D")
With wshTarget.Range("A" & lngHeaderRowStart & ":Z" & lngHeaderRowEnd)
.Font.Name = "Arial"
.Font.Size = 12
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
With wshTarget.PageSetup
.Orientation = xlLandscape
.PaperSize = xlPaperA3
.LeftMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.Zoom = 75
.PrintTitleRows = "$1:$7"
.PrintArea = "$A$1:$Z$" & lngLastRow
End With
lngNumRows = lngLastRow - lngFirstRow + 1
lngNumPages = lngNumRows \ lngRowsPerPage
If lngNumRows Mod lngRowsPerPage > 0 Then
lngNumPages = lngNumPages + 1
End If
For i = lngNumPages - 1 To 0 Step -1
lngRow = lngFirstRow + lngRowsPerPage * i
If i > 0 Then
wshTarget.Range("A" & lngRow).Resize(6).EntireRow.Insert
wshTarget.HPageBreaks.Add Before:=wshTarget.Range("A" & lngRow + 5)
End If
Next i
wshTarget.Columns("A:Z").AutoFit
Application.Goto wshTarget.Cells(lngHeaderRowStart, "A")
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Cursor = xlDefault
End Sub
Code: Select all
=MOD(SUM(100*SUM(J7:J32);I7:I32);100)
Code: Select all
=INT(SUM(100*SUM(J7:J32);I7:I32)/100)
Please see the attached workbook for example in Expected output sheet
Your assistance is greatly appreciated... thank you in advance