I’m currently using a macro that I need to run on every worksheet in a workbook. The amount of
worksheets in the workbook varies, however the last worksheet is always blank/available for use.
a few times to modify the macro so that it runs on every sheet in the book automatically with no success. Can anyone help?
Basically, I want it do the following:
1. Run on every worksheet in the workbook
2. Once complete on all worksheets, copy data in every worksheet and paste into the last worksheet in the workbook, or create
a new named worksheet and paste into that if easier.
Here’s the macro I’m using at the moment.. any
help would be great.
Public Sub OTC_TranTally_by_VA_Number()
' Variable Declarations
Dim lastrow As Long, r As Long
Dim Rw As Range
Dim mySum As Long
Dim lastrowA As Long
' Run 1st
' Delete's the Header Column from the spreadsheet
' Run 2nd
' Delete's the columns that are not required for the calculation
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
'Deletes the rows in the Item Count column with a zero value (debits)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
lastrow = ActiveSheet.UsedRange.Rows.Count
For r = lastrow To 1 Step -1
If UCase(Cells(r, 4).Value) = "0" Then Rows(r).Delete
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
' Run 4th
' Deletes the entire row within the selection if _
the ENTIRE row contains no data.
If WorksheetFunction.CountA(Selection) = 0 Then
.Calculation = xlCalculationManual
.ScreenUpdating = False
For Each Rw In Selection.Rows
If WorksheetFunction.CountA(Selection.EntireRow) = 0 Then
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
' Run 5th
' Sorts Column A into Ascending order so that the next calculation routine will work
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
' Run 6th
' Copies the text in Column D, then pastes as values for later calculation
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
' Run 7th
' adds the value of numbers in the first column
' together if the first to digits are the same.
' The results are then inserted into column E, in the row
' of the last matching number in Column A
lastrowA = Cells(Rows.Count, "a").End(xlUp).Row
oldKey = ""
For r = 1 To lastrowA + 1
newKey = Left(Cells(r, "a"), 2)
If newKey <> oldKey Then
If oldKey <> "" Then
Cells(r - 1, "e") = mySum
mySum = 0
oldKey = newKey
mySum = mySum + Cells(r, "d")
' Run 8th
' Delete's all rows with no value in Column E.
' Only returns VA numbers with a transaction
On Error Resume Next ' In case there are no blanks