Pages






Sub SplitTheWorkbook()
    Dim WBT As Workbook
    Dim WBO As Workbook
    Dim WBN As Workbook
    Dim WST As Worksheet
    Dim WSO As Worksheet
    Dim WSN As Worksheet
 
    Set WBT = ThisWorkbook
    Set WST = WBT.Worksheets(1)
    Set WBO = ActiveWorkbook
    Set WSO = ActiveSheet


    TopCount = WST.Range("C6").Value
    DivCount = WST.Range("C9").Value
 
    If WBT.Name = WBO.Name Then
        MsgBox "Please switch to the large workbook before Ctrl+Shift+S"
        Exit Sub
    End If
 
    MyName = WBO.Name
    MyPath = WBO.Path & Application.PathSeparator
    WST.Range("E17").Value = MyPath
 
    MyRows = WSO.UsedRange.Rows.Count
    WST.Range("E18").Value = MyRows
 
    RowsPerFile = Int(MyRows / DivCount) + 1
    WST.Range("E19").Value = RowsPerFile
 
    StartRow = TopCount + 1
    Ctr = 0
 
    For i = StartRow To MyRows Step RowsPerFile
        Ctr = Ctr + 1
        NewFN = MyPath & Format(Ctr, "000") & MyName
        Application.StatusBar = NewFN & " rows " & i & " to " & (i + RowsPerFile - 1)
        WSO.Copy
        Set WBN = ActiveWorkbook
        Set WSN = ActiveSheet
        KeepRow1 = i
        KeepRowN = i + RowsPerFile - 1
        DelRow1 = KeepRowN + 1
        ' Delete everything from DelRow1 on down
        DelSize1 = 1048576 - DelRow1
        Cells(DelRow1, 1).Resize(DelSize1, 1).EntireRow.Delete
        If i > StartRow Then
            ' Also delete rows at the top
            DelRow1 = StartRow
            Range(Cells(StartRow, 1), Cells(i - 1, 1)).EntireRow.Delete
        End If
        WBN.SaveAs NewFN, FileFormat:=WBO.FileFormat
        WBN.Close False
        WST.Cells(20 + Ctr, 2).Value = NewFN
    Next i
     
    WBT.Activate
    Application.StatusBar = False
    MsgBox Ctr & " files created"
 

End Sub

Private Sub Workbook_Open()
    Range("G2").Clear
End Sub





----------------------------------------------------------------------------------------------------


Private Sub CommandButton1_Click()

Dim myrange As Range
Dim Lastrow As Long
Dim sFolder As String
Lastrow = Sheets("sheet2").Cells(Sheets("sheet2").Rows.Count, "A").End(xlUp).Row + 1
'MsgBox Lastrow
Sheets("sheet2").Range("A" & Lastrow).Value = Date
Sheets("sheet2").Range("B" & Lastrow).Value = Time
Sheets("sheet2").Range("C" & Lastrow).Value = Sheets("sheet1").Range("B5").Value
Sheets("sheet2").Range("D" & Lastrow).Value = Sheets("sheet1").Range("C5").Value
Sheets("sheet2").Range("E" & Lastrow).Value = Application.UserName
Sheets("sheet2").Range("F" & Lastrow).Value = Format(Now(), "dd/mm/yyyy hh:MM:SS")

Sheets(1).CommandButton1.Enabled = False
Sheets(1).CommandButton2.Enabled = True

End Sub

Private Sub CommandButton2_Click()
Sheets(1).CommandButton1.Enabled = True
Sheets(1).CommandButton2.Enabled = False
Application.Cursor = xlDefault
lstrw = Sheets("sheet2").Cells(Sheets("sheet2").Rows.Count, "A").End(xlUp).Row
Sheets("sheet2").Range("G" & lstrw).Value = Time
Sheets("sheet2").Range("H" & lstrw).Value = Format(Now(), "dd/mm/yyyy hh:MM:SS")
Sheets("sheet2").Range("I" & lstrw).Value = Sheets("sheet2").Range("H" & lstrw).Value - Sheets("sheet2").Range("F" & lstrw).Value
End Sub