Hi

Here is a procedure I used. On sheets for current and previous months for
every row determined in setup are 4 rows in table (4 rows for every
employee)

Public Sub Seadistus()
' Removing passwords
Sheets("JooksevKuu").Unprotect Password:="***"
Sheets("EelmineKuu").Unprotect Password:="***"
Sheets("Nimekiri").Unprotect Password:="***"
Sheets("JK1").Unprotect Password:="***"
Sheets("JK2").Unprotect Password:="***"
Sheets("JK3").Unprotect Password:="***"
Sheets("JK4").Unprotect Password:="***"
Sheets("EK1").Unprotect Password:="***"
Sheets("EK2").Unprotect Password:="***"
Sheets("EK3").Unprotect Password:="***"
Sheets("EK4").Unprotect Password:="***"
' Setting up sheet JooksevKuu (CurrentMonth)
NewNumAll = Sheets("Seaded").Cells(5, 2).Value
LastRow = Sheets("JooksevKuu").Cells.Find("*",
searchdirection:=xlPrevious).Row
NumAllR = (LastRow - 8) / 4
i = 0
Do Until i = NumAllR
If Sheets("JooksevKuu").Cells(9 + 4 * i, 1).Value = "" Then Exit Do
If i 0 And Sheets("JooksevKuu").Cells(9 + 4 * i, 3).Value = ""
Then
Sheets("JooksevKuu").Range((9 + 4 * i) & ":" & (12 + 4 *
i)).Delete
NumAllR = NmAllR - 1
LastRow = LastRow - 4
Else
i = i + 1
End If
Loop
Select Case NewNumAll
Case Is < NumAllR
Sheets("JooksevKuu").Range((9 + 4 * NewNumAll) & ":" &
LastRow).Delete
Case Is NumAllR
Sheets("JooksevKuu").Range((LastRow - 3) & ":" & LastRow).Copy
(Sheets("JooksevKuu").Range((LastRow + 1) & ":" & 8 + 4 * NewNumAll))
End Select
'Copying department name from sheet Seaded (SetUp)
Sheets("JooksevKuu").Cells(3, 3).Value = Sheets("Seaded").Cells(1,
2).Value
'Copying department chief name from sheet Seaded
Sheets("JooksevKuu").Cells(4, 3).Value = Sheets("Seaded").Cells(2,
2).Value
' Setting up sheet JK1
LastRow = Sheets("JK1").Cells.Find("*", searchdirection:=xlPrevious).Row
NumAllR = (LastRow - 2)
Select Case NewNumAll
Case Is < NumAllR
Sheets("JK1").Range((2 + NewNumAll) & ":" & LastRow).Delete
Case Is NumAllR
Sheets("JK1").Range((LastRow) & ":" & LastRow).Copy
(Sheets("JK1").Range((LastRow + 1) & ":" & 2 + NewNumAll))
End Select
' Setting up sheet JK2
LastRow = Sheets("JK2").Cells.Find("*", searchdirection:=xlPrevious).Row
NumAllR = (LastRow - 2)
Select Case NewNumAll
Case Is < NumAllR
Sheets("JK2").Range((2 + NewNumAll) & ":" & LastRow).Delete
Case Is NumAllR
Sheets("JK2").Range((LastRow) & ":" & LastRow).Copy
(Sheets("JK2").Range((LastRow + 1) & ":" & 2 + NewNumAll))
End Select
' Setting up sheet JK3
LastRow = Sheets("JK3").Cells.Find("*", searchdirection:=xlPrevious).Row
NumAllR = (LastRow - 2)
Select Case NewNumAll
Case Is < NumAllR
Sheets("JK3").Range((2 + NewNumAll) & ":" & LastRow).Delete
Case Is NumAllR
Sheets("JK3").Range((LastRow) & ":" & LastRow).Copy
(Sheets("JK3").Range((LastRow + 1) & ":" & 2 + NewNumAll))
End Select
' Setting up sheet JK4
LastRow = Sheets("JK4").Cells.Find("*", searchdirection:=xlPrevious).Row
NumAllR = (LastRow - 2)
Select Case NewNumAll
Case Is < NumAllR
Sheets("JK4").Range((2 + NewNumAll) & ":" & LastRow).Delete
Case Is NumAllR
Sheets("JK4").Range((LastRow) & ":" & LastRow).Copy
(Sheets("JK4").Range((LastRow + 1) & ":" & 2 + NewNumAll))
End Select
' Setting up sheet EelmineKuu (PreviousMonth)
LastRow = Sheets("EelmineKuu").Cells.Find("*",
searchdirection:=xlPrevious).Row
NumAllR = (LastRow - 8) / 4
Select Case NewNumAll
Case Is < NumAllR
Sheets("EelmineKuu").Range((9 + 4 * NewNumAll) & ":" &
LastRow).Delete
Case Is NumAllR
Sheets("EelmineKuu").Range((LastRow - 3) & ":" & LastRow).Copy
(Sheets("EelmineKuu").Range((LastRow + 1) & ":" & 8 + 4 * NewNumAll))
End Select
' Setting up sheet EK1
LastRow = Sheets("EK1").Cells.Find("*", searchdirection:=xlPrevious).Row
NumAllR = (LastRow - 2)
Select Case NewNumAll
Case Is < NumAllR
Sheets("EK1").Range((2 + NewNumAll) & ":" & LastRow).Delete
Case Is NumAllR
Sheets("EK1").Range((LastRow) & ":" & LastRow).Copy
(Sheets("EK1").Range((LastRow + 1) & ":" & 2 + NewNumAll))
End Select
' Setting up sheet EK2
LastRow = Sheets("EK2").Cells.Find("*", searchdirection:=xlPrevious).Row
NumAllR = (LastRow - 2)
Select Case NewNumAll
Case Is < NumAllR
Sheets("EK2").Range((2 + NewNumAll) & ":" & LastRow).Delete
Case Is NumAllR
Sheets("EK2").Range((LastRow) & ":" & LastRow).Copy
(Sheets("EK2").Range((LastRow + 1) & ":" & 2 + NewNumAll))
End Select
' Setting up sheet EK3
LastRow = Sheets("EK3").Cells.Find("*", searchdirection:=xlPrevious).Row
NumAllR = (LastRow - 2)
Select Case NewNumAll
Case Is < NumAllR
Sheets("EK3").Range((2 + NewNumAll) & ":" & LastRow).Delete
Case Is NumAllR
Sheets("EK3").Range((LastRow) & ":" & LastRow).Copy
(Sheets("EK3").Range((LastRow + 1) & ":" & 2 + NewNumAll))
End Select
' Setting up sheet EK4
LastRow = Sheets("EK4").Cells.Find("*", searchdirection:=xlPrevious).Row
NumAllR = (LastRow - 2)
Select Case NewNumAll
Case Is < NumAllR
Sheets("EK4").Range((2 + NewNumAll) & ":" & LastRow).Delete
Case Is NumAllR
Sheets("EK4").Range((LastRow) & ":" & LastRow).Copy
(Sheets("EK4").Range((LastRow + 1) & ":" & 2 + NewNumAll))
End Select
' Seting up sheet Nimekiri (Employees list)
NewNumAll = Sheets("Seaded").Cells(11, 2).Value
LastRow = Sheets("Nimekiri").Cells.Find("*",
searchdirection:=xlPrevious).Row
NumAllR = LastRow - 1
Select Case NewNumAll
Case Is < NumAllR
Sheets("Nimekiri").Range((1 + NewNumAll) & ":" & LastRow).Delete
Case Is NumAllR
Sheets("Nimekiri").Range((LastRow) & ":" & LastRow).Copy
(Sheets("Nimekiri").Range((LastRow + 1) & ":" & 1 + NewNumAll))
End Select
' Protecting worksheets
Sheets("JooksevKuu").Protect Password:="***"
Sheets("EelmineKuu").Protect Password:="***"
Sheets("Nimekiri").Protect Password:="***"
Sheets("JK1").Protect Password:="***"
Sheets("JK2").Protect Password:="***"
Sheets("JK3").Protect Password:="***"
Sheets("JK4").Protect Password:="***"
Sheets("EK1").Protect Password:="***"
Sheets("EK2").Protect Password:="***"
Sheets("EK3").Protect Password:="***"
Sheets("EK4").Protect Password:="***"
End Sub

--
When sending mail, use address arvil<attarkon.ee
Arvi Laanemets


"Ralph Howarth" wrote in message
...
The setup table of premade formulas is much what I was thinking as the
next
logical step towards automation. I was thinking that a macro can perform
a
COUNTA of one column in the source data that represents the key field.
From
there have a Setup Worksheet be read with some premade formulas, and then
have a VBA script use a FOR-NEXT loop to calculate a row at a time using
the
formulas, then increment 1 for the next row to change the references back
to
the source data sheet that one row. Each row lays down until there is
nothing less to copy / calculate over.

I'll be chewing on this one for a while.