Sub MakeMeLoadsOfFlashCards()
     
   ' Super Sexy Excel Vocab Preparation Tool for making managable 100 entry wordlists
   ' in gflash+ so you can practice you vocab while ipoding.
   ' Copyright www.mywebstuff.com 2008
   ' this script is designed to make gflash+ excel files from large vocab lists
   ' Format of the vocabbooks is "VocabList_#(book)_#(firstrow)-#(lastrow).xls
   ' use at your own risk!
   ' Define Variables
   ' you might have to change the name of LocalDefaultWorkSheetName if your worksheets are different
   ' - depends on your local setting. I think it is Sheet1 in english excel versions
   
   currentBookNumber = 1
   currentItemNumber = 1
   rowPosCounter = 1
   rangePosStart = 1
   rangePosEnd = 100
   MyRange = ""
   
   LocalDefaultWorkSheetName = "Tabelle1"
   OutputName = ActiveWorkbook.Name
   OutputName = WorksheetFunction.Substitute(OutputName, ".xls", "_")
   CompleteOutputName = ""
   
   Dim wrksht As Worksheet
   Set wrksht = ActiveWorkbook.Worksheets(LocalDefaultWorkSheetName)
     
   wrksht.Activate
   wrksht.Range("A1").Activate
 
  
   Do While IsEmpty(ActiveCell.Offset(1, 0)) = False
      
       CompleteOutputName = OutputName & currentBookNumber & "_" & rangePosStart & "_" & rangePosEnd & ".xls"
            

       MyRange = "A" & rangePosStart & ":" & "B" & rangePosEnd
        
      
        If (Itemnumber = 100) Then
                              
            ' write vocab book here
            Set NewBook = Workbooks.Add
            With NewBook
                .SaveAs Filename:=CompleteOutputName
                wrksht.Range(MyRange).Copy Destination:=NewBook.Worksheets(LocalDefaultWorkSheetName).Range("A1")
            End With
            NewBook.Close
            
            ' increment for next book
            rangePosStart = rowPosCounter
            rangePosEnd = rowPosCounter + 100
            Itemnumber = 1
            currentBookNumber = currentBookNumber + 1
        Else
            Itemnumber = Itemnumber + 1
        End If
             
        rowPosCounter = rowPosCounter + 1
             
        ActiveCell.Offset(1, 0).Select
        
    Loop
    
    ' a bit awkward but here we need to actually write the last book with whatever rows were left over after the last 100 block
     
    CompleteOutputName = OutputName & currentBookNumber & "_" & rangePosStart & "_" & rowPosCounter & ".xls"
         
    Set NewBook = Workbooks.Add
    With NewBook
         .SaveAs Filename:=CompleteOutputName
          wrksht.Range(MyRange).Copy Destination:=NewBook.Worksheets(LocalDefaultWorkSheetName).Range("A1")
    End With
            
    NewBook.Close
  
    MsgBox "Done"

End Sub