Attribute VB_Name = "Module1"
Private Function SatunnaisLukuValilta(ByVal Alaraja As Long, ByVal Ylaraja As Long) As Long
  Randomize
  SatunnaisLukuValilta = Int((Ylaraja - Alaraja + 1) * Rnd + Alaraja)
End Function

Public Sub TestiData()
  Dim Rivi As Long
  Dim Tmp As Long
  Randomize
  For Rivi = 2 To 100
    Sheets("Import").Range("A" & Rivi).Value = SatunnaisLukuValilta(35000, 40000)
    Tmp = SatunnaisLukuValilta(1, 4)
    If Tmp = 1 Then
      Sheets("Import").Range("B" & Rivi).Value = "MikKas"
    ElseIf Tmp = 2 Then
      Sheets("Import").Range("B" & Rivi).Value = "HenSai"
    ElseIf Tmp = 3 Then
      Sheets("Import").Range("B" & Rivi).Value = "TeeMat"
    ElseIf Tmp = 4 Then
      Sheets("Import").Range("B" & Rivi).Value = "KirAhl"
    End If
    Sheets("Import").Range("C" & Rivi).Value = "Testirivi " & Rivi
  Next Rivi
End Sub

Private Sub LisaaSivu(ByVal ShNimi As String)
  ThisWorkbook.Sheets.Add
  ActiveSheet.Range("A1").Value = "Aikaleima"
  ActiveSheet.Range("B1").Value = "Käyttäjä"
  ActiveSheet.Range("C1").Value = "Datateksti"
  ActiveSheet.Name = ShNimi
End Sub

Private Function SivuOlemassa(ByVal ShNimi As String) As Boolean
'Funktiossa on esitelty TmpB-muuttuja,
'  joka asetetaan funktion lopussa (rivi 8) funktion vastaukseksi.
'Muuttuja alustetaan ensin arvolle False (rivi 3).
'Koodin rivillä 4 selvitetään työkirjassa olevien taulukkosivujen kappalemäärä ja tämän jälkeen silmukoidaan kaikki taulukkosivut (rivit 5-7).
'Silmukan sisällä verrataan kunkin taulukkosivun nimeä etsittävään nimeen (rivi 6) ja jos nimi täsmää, TmpB-muuttujaan asetetaan arvoksi True.
1  Dim TmpB As Boolean
2  Dim ShC As Long
3  TmpB = False
4  ShC = ThisWorkbook.Sheets.Count
5  For Lp = 1 To ShC
6    If ThisWorkbook.Sheets(Lp).Name = ShNimi Then TmpB = True
7  Next Lp
8  SivuOlemassa = TmpB
End Function

Private Function EkaTyhjaRivi(ByVal ShNimi As String) As Long
  EkaTyhjaRivi = CLng(Mid(Sheets(ShNimi).Range("A1").CurrentRegion.Address, 9)) + 1
End Function

Private Function EkaTyhjaRivi_Silmukalla(ByVal ShNimi As String) As Long
  Dim Rivi As Long
  Rivi = 2
  Do While (Sheets(ShNimi).Range("A" & Rivi).Value <> "")
    Rivi = Rivi + 1
  Loop
  EkaTyhjaRivi_Silmukalla = Rivi
End Function

Private Function TeeSiirrot() As Long
'Silmukkarakenteen ehtorivi on koodin rivillä 9.
'Silmukka päättyy riville 23.
'Silmukan sisällä tarkistetaan ensin, onko käsiteltävä rivi jo siirretty (rivi 10).
'Tämä selviää lukemalla käsiteltävän rivin D-sarakkeen arvo.
'Jos rivi on jo siirretty, siirtoa ei tehdä enää uudelleen,
'  vaan kontrolli siirtyy ehtolauseen lopetusriville 21.
'Huomaa erittäin haavoittuva osa tässä koodissa:
'  Rivilaskurin kasvattaminen pitää ehdottomasti tehdä vasta ehtolauseen päättymisrivin jälkeen.
'Jos koodin rivit 21 ja 22 vaihtaisivat paikkaa,
'  koodi päättyisi tietyissä tilanteissa (jos datassa olisi ainakin yksi rivi, joka on jo siirretty) päättymättömään silmukkaan.
'Silmukan sisällä otetaan ensin vuosiluku selville käsiteltävän rivin A-sarakkeen päivämäärästä (rivi 11) ja tallennetaan tieto NimiTmp-muuttujaan.
'Tämän muuttujan arvon perusteella selvitetään, onko taulukkosivu jo olemassa (rivi 12) ja lisätään se tarvittaessa (rivi 13).
'Rivillä 15 pyydetään vuoksikohtaisen arkistosivun ensimmäisen vapaan rivin numero KohdeRivi-muuttujaan.
'Tässä vaiheessa koodissa onkin tehty kaikki valmistelut itse datan kopiointia varten.
'Joten koodin riveillä 16-18 käsiteltävän rivin data kopioidaan Import-sivulta arkistosivulle ja rivillä 19 rivi merkitään siirretyksi.
'Rivillä 20 kasvataan SKpl-muuttujan arvoa yhdellä.
'Tässä muuttujassa pidetään tietoa käsiteltyjen rivien kappalemäärästä ja tämän muuttujan lopputulos asetetaan myös funktion vastaukseksi.
   Dim Rivi As Long
   Dim KohdeRivi As Long
   Dim Sivu As String
   Dim SKpl As Long
   Dim NimiTmp As String
   Rivi = 2
   Sivu = "Import"
   SKpl = 0
   Do While (Sheets(Sivu).Range("A" & Rivi).Value <> "")
10   If Sheets(Sivu).Range("D" & Rivi).Value <> "1" Then
11     NimiTmp = Year(Sheets(Sivu).Range("A" & Rivi).Value)
12     If Not SivuOlemassa(NimiTmp) Then
13       Call LisaaSivu(NimiTmp)
       End If
15       KohdeRivi = EkaTyhjaRivi(NimiTmp)
16     Sheets(NimiTmp).Range("A" & KohdeRivi).Value = Sheets(Sivu).Range("A" & Rivi).Value
17     Sheets(NimiTmp).Range("B" & KohdeRivi).Value = Sheets(Sivu).Range("B" & Rivi).Value
18     Sheets(NimiTmp).Range("C" & KohdeRivi).Value = Sheets(Sivu).Range("C" & Rivi).Value
19     Sheets(Sivu).Range("D" & Rivi).Value = 1
20     SKpl = SKpl + 1
21   End If
22   Rivi = Rivi + 1
   Loop
   TeeSiirrot = SKpl
End Function

Public Sub SiirtoMain()
  MsgBox "Siirto valmis. Siirretty " & TeeSiirrot & " riviä"
End Sub