Sub MonthEnd()
Dim rCl As Range, rDelete As Range
Dim sSht As String
sSht = InputBox("Enter new sheet name", "New Month Sheet")
If Len(sSht) = 0 Then
MsgBox "You must enter a name for the new sheet", vbCritical, "Quitting"
Exit Sub
''/// copy current sheet
Else: ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = sSht
For Each rCl In ActiveSheet.Range("Y10:Y9999").Cells
If rCl.Value = 0 Then
If rDelete Is Nothing Then
Set rDelete = Range("A" & rCl.Row, rCl)
Else: Set rDelete = Union(rDelete, Range("A" & rCl.Row, rCl))
End If
End If
Next rCl
If Not rDelete Is Nothing Then rDelete.Delete
MsgBox "Month End successfully completed", vbInformation, "Done"
End If
End Sub
Sub MACRO2()
'
' MACRO2 Macro
'
'
Range("Y10:Y3564").Select
ActiveWindow.ScrollRow = 3549
ActiveWindow.ScrollRow = 3542
ActiveWindow.ScrollRow = 3440
ActiveWindow.ScrollRow = 3146
ActiveWindow.ScrollRow = 3063
ActiveWindow.ScrollRow = 2979
ActiveWindow.ScrollRow = 2717
ActiveWindow.ScrollRow = 2417
ActiveWindow.ScrollRow = 2257
ActiveWindow.ScrollRow = 2110
ActiveWindow.ScrollRow = 1049
ActiveWindow.ScrollRow = 915
ActiveWindow.ScrollRow = 398
ActiveWindow.ScrollRow = 386
ActiveWindow.ScrollRow = 373
ActiveWindow.ScrollRow = 322
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 10
Range("Y10").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=6
Selection.Copy
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.SmallScroll Down:=-114
ActiveWindow.ScrollRow = 1027634
ActiveWindow.ScrollRow = 957611
ActiveWindow.ScrollRow = 437174
ActiveWindow.ScrollRow = 183578
ActiveWindow.ScrollRow = 10
Range("E10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F10:I16").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-22
Application.CutCopyMode = False
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-99
ActiveWindow.ScrollRow = 995562
ActiveWindow.ScrollRow = 10
Range("J10:X11").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=9
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
Selection.ClearContents
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 22
ActiveWindow.SmallScroll Down:=-147
ActiveWindow.ScrollRow = 859288
ActiveWindow.ScrollRow = 73821
ActiveWindow.SmallScroll Down:=-30
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWorkbook.Save
End Sub
Option Explicit
Sub Insert_100_Rows()
Dim LR As Long
LR = Range("Y" & Rows.Count).End(xlUp).Row 'detect last used row in column Y
Rows(LR & ":" & LR + 100).FillDown 'paste down formats & formulas (if any)
MsgBox "Done!"
End Sub