Something like this (untested) will cycle though books and sheets, creating a dated copy of each workbook and preserving the original.
Sub LooopBookAndSheets()
Dim wb as Workbook
Dim ws As Worksheet
Dim wbArr, bk
Dim Ext as String
Dim pth as string
pth = "C:\Test\" 'Change to suit
wbArr = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & pth & "*.xl*" & """ /b /a-d").stdout.readall, vbCrLf), ".")
For Each bk In wbArr
Set wb = Workbooks.Open(pth & bk)
For Each ws In wb.Worksheets
Call balance(ws)
Next ws
'Make a copy, close without saving
Ext = Right(wb.Name, 5)
wb.SaveCopyAs pth & Replace(wb.Name, Ext, "") & Format(Date, "_yy_mm_dd") & Ext
wb.Close False
Next bk
End Sub
Sub balance(ws As Worksheet)
With ws
' do all the years
For i = 2 To 11
' loop through all the accounts
For ii = 1 To 11
inarr = Range(.Cells(1, 1), .Cells(57, 11))
If inarr(45, i) < 0 Then
' we need to balance
' find largest account
maxb = 0
maxro = 0
For j = 45 To 56
If inarr(j, i) > maxb Then
maxb = inarr(j, i)
maxro = j
End If
Next j
If maxb > 0 Then
If maxro < 50 Then
'not taxable so dived by .7
balamount = (10000 - inarr(45, i)) / 0.6
accro = maxro - 43
Else
balamount = (10000 - inarr(45, i))
accro = maxro - 37
End If
If balamount > maxb Then
.Cells(accro, i) = maxb
Else
.Cells(accro, i) = balamount
End If
End If
End If
Next ii
Next i
End With
End Sub