Help with Macros to run on active worksheet

Hi All,
I have been given a workbook that pulls appts. in Outlook and drops them into a worksheet. I would like keep the workbook a running collection of different tabs throughout the year but the problem is when I "Move or Copy" and create a copy into a new tab the macro only works on the original sheet. I have tried editing the macro to run on the "ActiveSheet" but I must be doing it wrong since I keep getting an error code. Any suggestions? Much TIA

FYI
Sheet1 is the sheet that the outlook appts. are dumped into. This is the sheet that I want to change to be the active sheet.
Sheet2 is the sheet that has the dates that outlook will pull the appts. for. This one is auto populated with the current week once the workbook is open.

Here is the current code.

Option Explicit
Option Base 1
Sub GetApptsFromOutlook()
Application.ScreenUpdating = False
Call GetCalData(Sheet2.Range("Date_Monday"), Sheet2.Range("Date_Friday"))
Application.ScreenUpdating = True
End Sub

Private Function Quote(MyText)
Quote = Chr(34) & MyText & Chr(34)
End Function


Private Sub GetCalData(StartDate As Date, Optional EndDate As Date)
Const olFolderCalendar = 9
Const olAppointment = 26
' -------------------------------------------------
' Notes:
' If Outlook is not open, it still works, but much slower (~8 secs vs. 2 secs w/ Outlook open).
' Make sure to reference the Outlook object library before running the code
' End Date is optional, if you want to pull from only one day, use: Call GetCalData("7/14/2008")
' -------------------------------------------------

Dim olApp As Object 'Outlook.Application
Dim olNS As Object 'Outlook.Namespace
Dim myCalItems As Object 'As Outlook.Items
Dim ItemstoCheck As Object 'Outlook.Items
Dim ThisAppt As Object 'Outlook.AppointmentItem
Dim MyItem As Object
Dim StringToCheck As String
Dim MyBook As Object 'Excel.Workbook
Dim rngStart As Range 'Excel.Range
Dim rngStop As Range 'Excel.Range
Dim NextRow As Long
Dim NextColumn As Long
Dim NewDateFlag As Date
Dim olAppt As Object
Dim objCategory As Object 'Category
Dim ColorArray() As Variant
Dim i As Integer
Dim CalendarColor As Variant
Dim CalendarColorText As Variant
Dim Border


' if no end date was specified, then the requestor only wants one day, so set EndDate = StartDate
' this will let us return appts from multiple dates, if the requestor does in fact set an appropriate end date
If EndDate = "12:00:00 AM" Then EndDate = StartDate

If EndDate < StartDate Then
MsgBox "Those dates seem switched, please check them and try again.", vbInformation
GoTo ExitProc
End If

If EndDate - StartDate > 28 Then ' ask if the requestor wants so much info
If MsgBox("This could take some time. Continue anyway?", vbInformation + vbYesNo) = vbNo Then GoTo ExitProc
End If

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual



' get or create Outlook object and make sure it exists before continuing
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo ErrHandler
If olApp Is Nothing Then
MsgBox "Cannot start Outlook.", vbExclamation
GoTo ExitProc
End If
Set olNS = olApp.GetNamespace("MAPI")
If olNS.Categories.Count > 0 Then
ReDim ColorArray(olNS.Categories.Count, 4)
For Each objCategory In olNS.Categories ' Enumerate the Categories collection.
' Add the name and ID of the Category object to the output string.
i = i + 1
ColorArray(i, 1) = objCategory.Name ' & ": " & objCategory.Color & vbCrLf '& objCategory.CategoryID
ColorArray(i, 2) = objCategory.Color
If ColorArray(i, 2) = 1 Then ColorArray(i, 3) = RGB(231, 161, 162) 'Red
If ColorArray(i, 2) = 2 Then ColorArray(i, 3) = RGB(249, 186, 137) 'Orange
If ColorArray(i, 2) = 3 Then ColorArray(i, 3) = RGB(247, 221, 143) 'Peach
If ColorArray(i, 2) = 4 Then ColorArray(i, 3) = RGB(252, 250, 144) 'Yellow
If ColorArray(i, 2) = 5 Then ColorArray(i, 3) = RGB(120, 209, 104) 'Green
If ColorArray(i, 2) = 6 Then ColorArray(i, 3) = RGB(159, 220, 201) 'Teal
If ColorArray(i, 2) = 7 Then ColorArray(i, 3) = RGB(198, 210, 176) 'Olive
If ColorArray(i, 2) = 8 Then ColorArray(i, 3) = RGB(157, 183, 232) 'Blue
If ColorArray(i, 2) = 9 Then ColorArray(i, 3) = RGB(181, 161, 226) 'Purple
If ColorArray(i, 2) = 10 Then ColorArray(i, 3) = RGB(218, 174, 194) 'Maroon
If ColorArray(i, 2) = 11 Then ColorArray(i, 3) = RGB(218, 217, 220) 'Steel
If ColorArray(i, 2) = 12 Then ColorArray(i, 3) = RGB(107, 121, 148): ColorArray(i, 4) = RGB(255, 255, 255) 'DarkSteel
If ColorArray(i, 2) = 13 Then ColorArray(i, 3) = RGB(191, 191, 191) 'Gray
If ColorArray(i, 2) = 14 Then ColorArray(i, 3) = RGB(111, 111, 111): ColorArray(i, 4) = RGB(255, 255, 255) 'Dark Gray
If ColorArray(i, 2) = 15 Then ColorArray(i, 3) = RGB(79, 79, 79): ColorArray(i, 4) = RGB(255, 255, 255) 'Black
If ColorArray(i, 2) = 16 Then ColorArray(i, 3) = RGB(193, 26, 37): ColorArray(i, 4) = RGB(255, 255, 255) 'DarkRed
If ColorArray(i, 2) = 17 Then ColorArray(i, 3) = RGB(226, 98, 13): ColorArray(i, 4) = RGB(255, 255, 255) 'DarkOrange
If ColorArray(i, 2) = 18 Then ColorArray(i, 3) = RGB(199, 153, 48) 'DarkPeach
If ColorArray(i, 2) = 19 Then ColorArray(i, 3) = RGB(185, 179, 0) 'DarkYellow
If ColorArray(i, 2) = 20 Then ColorArray(i, 3) = RGB(54, 143, 43): ColorArray(i, 4) = RGB(255, 255, 255) 'DarkGreen
If ColorArray(i, 2) = 21 Then ColorArray(i, 3) = RGB(50, 155, 122): ColorArray(i, 4) = RGB(255, 255, 255) 'DarkTeal
If ColorArray(i, 2) = 22 Then ColorArray(i, 3) = RGB(119, 139, 69): ColorArray(i, 4) = RGB(255, 255, 255) 'DarkOlive
If ColorArray(i, 2) = 23 Then ColorArray(i, 3) = RGB(40, 88, 165): ColorArray(i, 4) = RGB(255, 255, 255) 'DarkBlue
If ColorArray(i, 2) = 24 Then ColorArray(i, 3) = RGB(92, 63, 163): ColorArray(i, 4) = RGB(255, 255, 255) 'DarkPurple
If ColorArray(i, 2) = 25 Then ColorArray(i, 3) = RGB(147, 68, 107): ColorArray(i, 4) = RGB(255, 255, 255) 'DarkMaroon
Next
End If
Set myCalItems = olNS.GetDefaultFolder(olFolderCalendar).Items

' ------------------------------------------------------------------
With myCalItems
.Sort "[Start]", False
.IncludeRecurrences = True
End With

StringToCheck = "[Start] >= " & Quote(StartDate & " 12:00 AM") & " AND [End] <= " & Quote(EndDate & " 11:59 PM")
'Debug.Print StringToCheck

Set ItemstoCheck = myCalItems.Restrict(StringToCheck)
'Debug.Print ItemstoCheck.Count
' ------------------------------------------------------------------

If ItemstoCheck.Count < 1 Then
MsgBox "There are no appointments or meetings on your calendar this week!", vbCritical
GoTo ExitProc ' we didn't find any appt
End If
If ItemstoCheck.Item(1) Is Nothing Then
MsgBox "There are no appointments or meetings on your calendar this week!", vbExclamation
GoTo ExitProc ' check if there are actually any items in the collection, otherwise exit
End If
' oa.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).
'Set MyBook = Excel.Workbooks.Add
Set rngStart = Sheet3.Range("CalendarStartCell")
Set rngStop = Sheet3.Range("CalendarStopCell")
Sheet3.Range("CalendarData").ClearContents
Sheet3.Range("CalendarData").Interior.Color = xlNone
Sheet3.Range("CalendarData").Font.ColorIndex = 0
For Each Border In Sheet3.Range("CalendarData")
Border.Borders(xlEdgeBottom).LineStyle = xlNone
Next
Application.ScreenUpdating = True
Application.ScreenUpdating = False

NewDateFlag = Format(Sheet2.Range("Date_Monday").Value2, "MM/DD/YYYY")
NextRow = 0
NextColumn = 0
For Each MyItem In ItemstoCheck
If MyItem.Class = olAppointment Then
' MyItem is the appointment or meeting item we want, set obj reference to it
Set ThisAppt = MyItem
If ThisAppt.Categories <> "Not Urgent/Not Important" Then
If NewDateFlag <> Format(ThisAppt.Start, "MM/DD/YYYY") Then
NextColumn = NextColumn + 1
NextRow = 0
NewDateFlag = Format(ThisAppt.Start, "MM/DD/YYYY")
Application.ScreenUpdating = True
Application.ScreenUpdating = False
End If
'CalendarColor = ColorArray(Application.Match(ThisAppt.Categories, ColorArray(), False), 3)
CalendarColor = Null
CalendarColorText = RGB(0, 0, 0)
For i = 1 To UBound(ColorArray, 1)
If ColorArray(i, 1) = ThisAppt.Categories Then CalendarColor = ColorArray(i, 3): CalendarColorText = ColorArray(i, 4)
Next i
If rngStop.Row >= rngStart.Offset(1 + NextRow, NextColumn).Row Then
With rngStart
If IsNull(CalendarColor) = False Then .Offset(0 + NextRow, NextColumn).Interior.Color = CalendarColor: .Offset(0 + NextRow, NextColumn).Font.Color = CalendarColorText
.Offset(0 + NextRow, NextColumn).Value = "[ ] " & ThisAppt.Subject
'.Offset(1 + NextRow, NextColumn).Value = Format(ThisAppt.Start, "MM/DD/YYYY")'Format(ThisAppt.Start, "MM/DD/YYYY HH:MM AM/PM")
If IsNull(CalendarColor) = False Then .Offset(1 + NextRow, NextColumn).Interior.Color = CalendarColor: .Offset(1 + NextRow, NextColumn).Font.Color = CalendarColorText
.Offset(1 + NextRow, NextColumn).Borders(xlEdgeBottom).Weight = xlThin
.Offset(1 + NextRow, NextColumn).Value = Format(ThisAppt.Start, "HH:MMAM/PM") & "-" & Format(ThisAppt.End, "HH:MMAM/PM") & " " & ThisAppt.Location
'.Offset(2 + NextRow, NextColumn).Value = Format(ThisAppt.End, "MM/DD/YYYY")'Format(ThisAppt.End, "MM/DD/YYYY HH:MM AM/PM")
'.Offset(2 + NextRow, NextColumn).Value = ThisAppt.Location
End With
End If
NextRow = NextRow + 2
End If

End If

Next MyItem

Sheet3.Range("CalendarData").Borders(xlEdgeBottom).LineStyle = xlContinuous
Sheet3.Range("CalendarData").Borders(xlEdgeBottom).Weight = xlMedium


ExitProc:
Set myCalItems = Nothing
Set ItemstoCheck = Nothing
Set olNS = Nothing
Set olApp = Nothing
Set rngStart = Nothing
Set ThisAppt = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
ErrHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub

The code mentions Sheet2 and Sheet3. But note, these are not necessarily the sheet names you see on the tabs. Here the code names of the sheets are used. Assuming Sheet2 is the active sheet, then in the VBA editor, use the keyboard shortcut Ctrl+H, in the Find What field, type Sheet2, and in the Replace With field type ActiveSheet and replace all occurrences in the code. As for Sheet3. In the project tree, check what code name the second sheet has. If it is indeed Sheet3, then you don't need to do anything else. If the code name is different follow the same steps as with changing the first sheet. Type Sheet3 in the Find field and the actual code name of the sheet in the Replace field.

Artik