Thank you Bob. I would love for someone to teach me but I don't know if you
would want to. I hardly even know the basics when it comes to macros. Here
are the two items that Ihave been running independently, but I want to run at
once:
FIRST
Sub SaveEachSheetasFile()
Dim AWn As String, AWp As String, WS As Worksheet, WB As Workbook
Set WB = ActiveWorkbook
AWn = WB.Name
'This line sets the saveas path, currently set to active workbook's path
AWp = WB.Path
Application.ScreenUpdating = False
For Each WS In WB.Sheets
WS.Copy
ActiveWorkbook.SaveAs Filename:=AWp & "\" & WS.Name
'
ActiveWorkbook.Close
Next WS
' WB.Close 'Remove the comment from this line to close the original workbook
after macro is done
Application.ScreenUpdating = True
End Sub
Sub CreateSheets()
' Insert blank in Row 2
Rows("2:2").Select
Selection.Insert Shift:=xlDown
' Sort column A
Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Declare our variables
Dim wks1 As Worksheet, wks2 As Worksheet
Set wks1 = Application.ActiveWorkbook.ActiveSheet
'Define a department that won't exist be found
CurrentDept = "NotAValidDept"
'Scroll through each row of the worksheet
For i = 1 To wks1.UsedRange.Rows.Count
'And get the department name for each row
thisDept = wks1.Cells(i, 2)
'If we are dealing with a new department...
If (Not thisDept = CurrentDept) Then
'make sure it has a name (not null)
If (thisDept = "") Then
thisDept = "NULL"
End If
'Create a new worksheet for the new department
CurrentDept = thisDept
Application.ActiveWorkbook.Sheets.Add.Move
after:=Worksheets(Worksheets.Count)
Set wks2 = Application.ActiveWorkbook.Sheets(Worksheets.Count)
wks2.Name = thisDept
'Copy the header row
wks1.Rows(1).Copy wks2.Rows(1)
End If
'Copy the data row
wks1.Rows(i).Copy wks2.Rows(wks2.UsedRange.Rows.Count + 1)
Next
End Sub
Sub DeleteBlankRow2()
' Deletes the Blank in row 2
Sheets("Sheet1").Select
Rows("2:2").Select
Selection.Delete Shift:=xlUp
MsgBox ActiveWorkbook.Path
End Sub
Sub NewSub()
Call CreateSheets
Call DeleteBlankRow2
Call SaveEachSheetasFile
End Sub
SECOND
Sub VBAMacro()
Dim rng As Range
' Autofit columns B through D
Columns("B
").EntireColumn.AutoFit
' Adds columns totals for F through O
' Jodie to change how many rows between the last number and where
the total is
' Set rng = [G65536].End(xlUp).Offset("CHANGE THIS VALUE", 0)
Set rng = [G65536].End(xlUp).Offset(2, 0)
rng = WorksheetFunction.Sum(Range(rng.Offset(-1, 0), Cells(1,
rng.Column)))
Set rng = [H65536].End(xlUp).Offset(2, 0)
rng = WorksheetFunction.Sum(Range(rng.Offset(-1, 0), Cells(1,
rng.Column)))
Set rng = [I65536].End(xlUp).Offset(2, 0)
rng = WorksheetFunction.Sum(Range(rng.Offset(-1, 0), Cells(1,
rng.Column)))
Set rng = [J65536].End(xlUp).Offset(2, 0)
rng = WorksheetFunction.Sum(Range(rng.Offset(-1, 0), Cells(1,
rng.Column)))
Set rng = [K65536].End(xlUp).Offset(2, 0)
rng = WorksheetFunction.Sum(Range(rng.Offset(-1, 0), Cells(1,
rng.Column)))
Set rng = [L65536].End(xlUp).Offset(2, 0)
rng = WorksheetFunction.Sum(Range(rng.Offset(-1, 0), Cells(1,
rng.Column)))
Set rng = [M65536].End(xlUp).Offset(2, 0)
rng = WorksheetFunction.Sum(Range(rng.Offset(-1, 0), Cells(1,
rng.Column)))
Set rng = [N65536].End(xlUp).Offset(2, 0)
rng = WorksheetFunction.Sum(Range(rng.Offset(-1, 0), Cells(1,
rng.Column)))
Set rng = [O65536].End(xlUp).Offset(2, 0)
rng = WorksheetFunction.Sum(Range(rng.Offset(-1, 0), Cells(1,
rng.Column)))
Columns("C:C").Select
Selection.EntireColumn.Hidden = True
Columns("E:E").Select
Selection.EntireColumn.Hidden = True
Columns("A:A").Select
Selection.EntireColumn.Hidden = True
Cells.Select
Range("D1").Activate
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.PrintGridlines = True
.Orientation = xlLandscape
.PrintTitleRows = ""
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 5
End With
Rows("1:1").Select
Selection.Replace What:="SumOf", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveWorkbook.Save
End Sub
Are you able to help with this?