Excel opening separate files in new instance causing problems

T

tomleitch

Board Regular
Joined
Jan 3, 2012
Messages
189
Hi all,

I have a macro that when it runs opens another workbook and triggers a macro in it to copy some sheets over from the original workbook.

The trouble is that sometimes excel runs as a separate instance and it is causing me lots of problems as it doesn't handle clipboard/copying items in the same way and the two can't speak to each other.

Is there a way to force excel through VBA to open the second workbook within the original instance of excel, so the two can copy properly and work between each other?


Codes are:

Starting code from instance 1 in first workbook:


VBA Code: 
Sub UpdateReadiness()

Dim W3 As Boolean
Dim OutputFile As Workbook
Dim caworkbook As String
Dim security As MsoAutomationSecurity

If ThisWorkbook.ReadOnly = True Then
MsgBox "You do not have permission to update readiness", vbOKOnly, "ACCESS DENIED"
Exit Sub
End If


ans = MsgBox("Update data from Book1 and Book2" & vbNewLine & "trackers into readiness tracker?", vbOKCancel, "DATA UPDATE")
If ans = vbCancel Then Exit Sub


Sheets("SETTINGS").Range("BL1") = 1
Call Graphcalc

With UserForm12
  .StartUpPosition = 0
  .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
  .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
  .Show (False)
End With



UserForm12.Show (False)
UserForm12.Repaint


Application.ScreenUpdating = True

Application.Wait (Now + TimeValue("0:00:03"))

Application.ScreenUpdating = False

security = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityLow

caworkbook = ActiveWorkbook.Path + "/Readiness Tracker.xlsm"


On Error Resume Next
If BookOpen("Readiness Tracker.xlsm") = False Then
Workbooks.Open (caworkbook), UpdateLinks:=0, IgnoreReadOnlyRecommended:=True, Notify:=False, CorruptLoad:=xlNormalLoad
Application.AutomationSecurity = security
W3 = True
End If

Call Workbooks("Readiness Tracker.xlsm").Sheets("WELCOME").Updater


If Err.Number <> 0 Then MsgBox "Error - Readiness tracker not updated", , "UPDATE ERROR"

Unload UserForm12


End Sub




And in the second workbook the Updater macro should be triggered:


Code: 
Sub Updater()



Dim W1 As Boolean
Dim W2 As Boolean
Dim W1E As Boolean
Dim W2E As Boolean
Dim rng As Range
Dim TwoWH As Boolean
Dim SixWH As Boolean
Dim TweWH As Boolean
Dim OutputFile As Workbook
Dim WorkscopeWHR As Range
Dim caworkbook As String
Dim Lrow As Long
Dim security As MsoAutomationSecurity




On Error GoTo 90


With UserForm12
  .StartUpPosition = 0
  .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
  .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
  .Show (False)
End With



UserForm12.Show (False)
UserForm12.Repaint


Application.ScreenUpdating = True

Application.Wait (Now + TimeValue("0:00:02"))

Application.ScreenUpdating = False



Application.ScreenUpdating = False

'''' Opening ops planner as read only



security = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityLow

caworkbook = ActiveWorkbook.Path + "/Ops Planner Tracker.xlsm"
On Error Resume Next


If BookOpen("Ops Planner Tracker.xlsm") = False Then
'If CheckFileIsOpen("Ops Planner Tracker.xlsm") = False Then
Workbooks.Open (caworkbook), UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True, Notify:=False, CorruptLoad:=xlNormalLoad
Application.AutomationSecurity = security
W1 = True
End If


If Err.Number <> 0 Then
MsgBox "Error - Data not updated - Ops Planner Tracker not found" & vbNewLine & vbNewLine & "Close all spreadsheets and try again", , "UPDATE ERROR"
GoTo 100
End If



security = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityLow
caworkbook = ActiveWorkbook.Path + "/Maint Specialist Tracker.xlsm"
On Error Resume Next
If BookOpen("Maint Specialist Tracker.xlsm") = False Then
'If CheckFileIsOpen("Maint Specialist Tracker.xlsm") = False Then
Workbooks.Open (caworkbook), UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True, Notify:=False, CorruptLoad:=xlNormalLoad
Application.AutomationSecurity = security
W2 = True
End If

If Err.Number <> 0 Then
MsgBox "Error - Data not updated - Maint Specialist Tracker not found" & vbNewLine & vbNewLine & "Close all spreadsheets and try again", , "UPDATE ERROR"
GoTo 100
End If

Call Workbooks("Maint Specialist Tracker.xlsm").Recalcar
Call Workbooks("Ops Planner Tracker.xlsm").Recalcar



On Error GoTo 90


Application.EnableEvents = True


10 ThisWorkbook.Sheets("OPERATIONS").Unprotect Password:="Password"
11 ThisWorkbook.Sheets("MAINTENANCE").Unprotect Password:="Password"
12 ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Unprotect Password:="Password"



'#Clearing data


On Error Resume Next
ThisWorkbook.Sheets("OPERATIONS").Range("A:BF").EntireColumn.Hidden = False
ThisWorkbook.Sheets("MAINTENANCE").Range("A:BF").EntireColumn.Hidden = False
ThisWorkbook.Sheets("OPERATIONS").ShowAllData
ThisWorkbook.Sheets("MAINTENANCE").ShowAllData
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").ShowAllData
ThisWorkbook.Sheets("OPERATIONS").Range("A10:BF10009").Clear
ThisWorkbook.Sheets("OPERATIONS").Range("A10:BF10009").ClearComments
ThisWorkbook.Sheets("MAINTENANCE").Range("A10:BF10009").Clear
ThisWorkbook.Sheets("MAINTENANCE").Range("A10:BF10009").ClearComments
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Range("A3:V20009").Clear
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Range("A3:V20009").ClearComments
ThisWorkbook.Sheets("CALCS").Range("A10:BE10009").Clear
ThisWorkbook.Sheets("OPERATIONS").Range("A10:BF10009").Interior.Color = RGB(255, 255, 255)
ThisWorkbook.Sheets("MAINTENANCE").Range("A10:BF10009").Interior.Color = RGB(255, 255, 255)
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Range("A3:V20009").Interior.Color = RGB(255, 255, 255)
'#Cleared
On Error GoTo 90






'''''''''Copying Frozen plan date to settings
ThisWorkbook.Sheets("SETTINGS").Range("L4").Value = Workbooks("Ops Planner Tracker.xlsm").Sheets("SETTINGS").Range("W2").Value



''''Copying OPS PLANNER and MAINT TTRACKER sheet to viewer
Application.EnableEvents = False
Workbooks("Ops Planner Tracker.xlsm").Sheets("OPS PLANNER").Copy Before:=ThisWorkbook.Sheets("WELCOME")
Workbooks("Maint Specialist Tracker.xlsm").Sheets("MAINT").Copy Before:=ThisWorkbook.Sheets("WELCOME")
Application.EnableEvents = True

'''''COPY IN PLAN WEEK DATES
ThisWorkbook.Sheets("OPS PLANNER").Range("B3:B6").Copy
ThisWorkbook.Sheets("WELCOME").Range("K5").PasteSpecial Paste:=xlPasteValues



'Clear COW readiness

Sheets("CoW STATS").Range("A1:H54").ClearContents
Sheets("CoW STATS").Range("J1:DW2000").ClearContents



''''UPDATING PROD GRAPH CALCS FOR CoW READINESS

Application.StatusBar = "Importing Data - PROD Graph calcs.. "

Dim Lrow2 As Long

With Workbooks("Ops Planner Tracker.xlsm").Sheets("SETTINGS")
Lrow2 = Workbooks("Ops Planner Tracker.xlsm").Sheets("SETTINGS").Cells(Rows.Count, 88).End(xlUp).Row
   .Range(.Cells(1, 88), .Cells(Lrow2, 138)).Copy
End With

ThisWorkbook.Sheets("CoW STATS").Range("J2").PasteSpecial Paste:=xlPasteValues




Workbooks("Ops Planner Tracker.xlsm").Sheets("SETTINGS").Range("A61:F72").Copy

ThisWorkbook.Sheets("CoW STATS").Range("A2").PasteSpecial Paste:=xlPasteValues


'''''''''''''''''''''''''''''''''

''''UPDATING MAINT GRAPH CALCS FOR CoW READINESS

Application.StatusBar = "Importing Data - MAINT Graph calcs.. "


With Workbooks("Maint Specialist Tracker.xlsm").Sheets("SETTINGS")
Lrow2 = Workbooks("Maint Specialist Tracker.xlsm").Sheets("SETTINGS").Cells(Rows.Count, 88).End(xlUp).Row
   .Range(.Cells(1, 88), .Cells(Lrow2, 160)).Copy
End With

ThisWorkbook.Sheets("CoW STATS").Range("BC2").PasteSpecial Paste:=xlPasteValues



Workbooks("Maint Specialist Tracker.xlsm").Sheets("SETTINGS").Range("A61:F96").Copy

ThisWorkbook.Sheets("CoW STATS").Range("A17").PasteSpecial Paste:=xlPasteValues


'''''''''''''''''''''''''''''''''



''''UPDATING PROD GRAPH CALCS for gate readiness ##############DISABLED

GoTo 25


Application.StatusBar = "Importing Data - PROD Graph calcs.. "


With Workbooks("Ops Planner Tracker.xlsm").Sheets("SETTINGS")
Lrow2 = Workbooks("Ops Planner Tracker.xlsm").Sheets("SETTINGS").Cells(Rows.Count, 26).End(xlUp).Row
   .Range(.Cells(1, 26), .Cells(Lrow2, 33)).Copy
End With

ThisWorkbook.Sheets("CALCS").Range("A2").PasteSpecial Paste:=xlPasteValues

Workbooks("Ops Planner Tracker.xlsm").Sheets("SETTINGS").Range("A16:B21").Copy

ThisWorkbook.Sheets("CALCS").Range("AQ3").PasteSpecial Paste:=xlPasteValues

With Workbooks("Ops Planner Tracker.xlsm").Sheets("SETTINGS")
Lrow2 = Workbooks("Ops Planner Tracker.xlsm").Sheets("SETTINGS").Cells(Rows.Count, 26).End(xlUp).Row
   .Range("AQ2:BB2").Copy
End With

ThisWorkbook.Sheets("CALCS").Range("I3").PasteSpecial Paste:=xlPasteValues


25

'''''''''''''''''''''''''''''''''

30

''''''''''Updating Maint Graph gate Calcs ##################DISABLED
GoTo 35

Application.StatusBar = "Importing Data - MAINT Graph calcs.. "

With Workbooks("Maint Specialist Tracker.xlsm").Sheets("SETTINGS")
Lrow2 = Workbooks("Maint Specialist Tracker.xlsm").Sheets("SETTINGS").Cells(Rows.Count, 26).End(xlUp).Row
   .Range(.Cells(1, 26), .Cells(Lrow2, 33)).Copy
End With

ThisWorkbook.Sheets("CALCS").Range("U2").PasteSpecial Paste:=xlPasteValues

Workbooks("Maint Specialist Tracker.xlsm").Sheets("SETTINGS").Range("A16:B21").Copy

ThisWorkbook.Sheets("CALCS").Range("AT2").PasteSpecial Paste:=xlPasteValues

With Workbooks("Maint Specialist Tracker.xlsm").Sheets("SETTINGS")
Lrow2 = Workbooks("Maint Specialist Tracker.xlsm").Sheets("SETTINGS").Cells(Rows.Count, 26).End(xlUp).Row
   .Range("AQ2:BB2").Copy
End With

ThisWorkbook.Sheets("CALCS").Range("AC3").PasteSpecial Paste:=xlPasteValues


35

''''Close ops planner and maint tracker if it wasn't already open
If W1 = True Then
If Workbooks("Ops Planner Tracker.xlsm").ReadOnly = True Then
Workbooks("Ops Planner Tracker.xlsm").Close savechanges:=False
Else: Workbooks("Ops Planner Tracker.xlsm").Close
End If
End If

If W2 = True Then
If Workbooks("Maint Specialist Tracker.xlsm").ReadOnly = True Then
Workbooks("Maint Specialist Tracker.xlsm").Close savechanges:=False
Else: Workbooks("Maint Specialist Tracker.xlsm").Close
End If
End If

'''''Importing PROD sheet data
Application.StatusBar = "Importing Data - Ops Planner Jobs.. "

twowr = ThisWorkbook.Sheets("OPS PLANNER").Range("9:9").Find("NOTES").Column - 1
Twowl = ThisWorkbook.Sheets("OPS PLANNER").Range("9:9").Find(what:="2WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
sixwr = Twowl - 1
sixwl = ThisWorkbook.Sheets("OPS PLANNER").Range("9:9").Find(what:="6WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
twelvewr = sixwl - 1
twelvewl = ThisWorkbook.Sheets("OPS PLANNER").Range("9:9").Find(what:="12WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
WorkscopeR = ThisWorkbook.Sheets("OPS PLANNER").Range("9:9").Find(what:="PLANNING WEEK START", lookat:=xlWhole, MatchCase:=False).Column - 1
WorkscopeL = ThisWorkbook.Sheets("OPS PLANNER").Range("9:9").Find(what:="TITLE", lookat:=xlWhole, MatchCase:=False).Column + 1
lcol = ThisWorkbook.Sheets("OPS PLANNER").Cells(9, Columns.Count).End(xlToLeft).Column

ThisWorkbook.Sheets("OPS PLANNER").Range("A:CZ").EntireColumn.Hidden = False

On Error Resume Next
ThisWorkbook.Worksheets("OPS PLANNER").ShowAllData
On Error GoTo 90

Lrow = ThisWorkbook.Sheets("OPS PLANNER").Cells(Rows.Count, 1).End(xlUp).Row

Application.EnableEvents = False

ThisWorkbook.Sheets("OPS PLANNER").Range("A10", Sheets("OPS PLANNER").Cells(10009, lcol)).Copy
ThisWorkbook.Sheets("OPERATIONS").Range("A10").PasteSpecial Paste:=xlPasteFormats
ThisWorkbook.Sheets("OPERATIONS").Range("A10").PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Sheets("OPERATIONS").Range("A10").PasteSpecial Paste:=xlPasteComments
Application.GoTo ThisWorkbook.Sheets("OPERATIONS").Cells(1, 1)
Application.CutCopyMode = False
Application.EnableEvents = True


''''''''''PROD UPDATED JOBS UPDATED


'####################### IMPORT MAINT

Application.EnableEvents = False

ThisWorkbook.Sheets("MAINT").Activate
Application.StatusBar = "Importing Maint Specialist Data... "
Application.EnableEvents = False


twowr = ThisWorkbook.Sheets("MAINT").Range("9:9").Find("NOTES").Column - 1
Twowl = ThisWorkbook.Sheets("MAINT").Range("9:9").Find(what:="2WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
sixwr = Twowl - 1
sixwl = ThisWorkbook.Sheets("MAINT").Range("9:9").Find(what:="6WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
twelvewr = sixwl - 1
twelvewl = ThisWorkbook.Sheets("MAINT").Range("9:9").Find(what:="12WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
WorkscopeR = ThisWorkbook.Sheets("MAINT").Range("9:9").Find(what:="PLANNING WEEK START", lookat:=xlWhole, MatchCase:=False).Column - 1
WorkscopeL = ThisWorkbook.Sheets("MAINT").Range("9:9").Find(what:="TITLE", lookat:=xlWhole, MatchCase:=False).Column + 1
lcol = ThisWorkbook.Sheets("MAINT").Cells(9, Columns.Count).End(xlToLeft).Column
On Error Resume Next

ThisWorkbook.Sheets("MAINT").Range("A:CZ").EntireColumn.Hidden = False
ThisWorkbook.Worksheets("MAINT").ShowAllData
On Error GoTo 90

Lrow = ThisWorkbook.Sheets("MAINT").Cells(Rows.Count, 1).End(xlUp).Row

Application.EnableEvents = False

ThisWorkbook.Sheets("MAINT").Range("A10", Sheets("MAINT").Cells(10009, lcol)).Copy
ThisWorkbook.Sheets("MAINTENANCE").Range("A10").PasteSpecial Paste:=xlPasteFormats
ThisWorkbook.Sheets("MAINTENANCE").Range("A10").PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Sheets("MAINTENANCE").Range("A10").PasteSpecial Paste:=xlPasteComments
'Application.GoTo ThisWorkbook.Sheets("MAINTENANCE").Cells(1, 1)
Application.CutCopyMode = False
Application.EnableEvents = True



Application.StatusBar = False

'''''''''''''Close Maint Tracker if not already open









Application.ScreenUpdating = False

45

On Error GoTo 90


 Lrow = Sheets("OPERATIONS").Cells(Rows.Count, 1).End(xlUp).Row
 PLANWST = Sheets("OPERATIONS").Range("9:9").Find(what:="PLANNING WEEK START", lookat:=xlWhole, MatchCase:=False).Column
 twowk = Sheets("OPERATIONS").Range("9:9").Find(what:="2WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
 sixwk = Sheets("OPERATIONS").Range("9:9").Find(what:="6WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
 TWELVEWK = Sheets("OPERATIONS").Range("9:9").Find(what:="12WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
 twelveAV = Sheets("ACTIVITY OVERVIEW").Range("2:2").Find(what:="12WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
 sixAV = Sheets("ACTIVITY OVERVIEW").Range("2:2").Find(what:="6WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
 twoAV = Sheets("ACTIVITY OVERVIEW").Range("2:2").Find(what:="2WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column


Application.StatusBar = "Importing Data - Activity overview (Operations)... "


ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Unprotect Password:="Password"

On Error Resume Next
ThisWorkbook.Worksheets("OPERATIONS").ShowAllData
On Error GoTo 90

Lrow2 = Sheets("ACTIVITY OVERVIEW").Cells(Rows.Count, 1).End(xlUp).Row

'Copy in prod workscope


Application.EnableEvents = False


46 If ThisWorkbook.Sheets("OPERATIONS").Range("A10", Sheets("OPERATIONS").Cells(Lrow, TWELVEWK)).SpecialCells(xlCellTypeVisible).Count > 1 Then


47 Worksheets("OPERATIONS").Range("A10", Sheets("OPERATIONS").Cells(Lrow, "T")).Copy

48  ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), "A").PasteSpecial Paste:=xlPasteFormats
49 ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), "A").PasteSpecial Paste:=xlPasteValues
On Error Resume Next
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), "A").PasteSpecial Paste:=xlPasteComments
On Error GoTo 90
Application.CutCopyMode = False

Worksheets("OPERATIONS").Range("P10", Sheets("OPERATIONS").Cells(Lrow, "T")).Copy

ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), "O").PasteSpecial Paste:=xlPasteFormats
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), "O").PasteSpecial Paste:=xlPasteValues
On Error Resume Next
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), "O").PasteSpecial Paste:=xlPasteComments
On Error GoTo 90
Application.CutCopyMode = False



'Copy in prod 12wk gate
With Worksheets("OPERATIONS")
   .Range(.Cells(10, TWELVEWK), .Cells(Lrow, TWELVEWK)).Copy
End With

ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), twelveAV).PasteSpecial Paste:=xlPasteFormats
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), twelveAV).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Copy in prod 6wk Gate

With Worksheets("OPERATIONS")
   .Range(.Cells(10, sixwk), .Cells(Lrow, sixwk)).Copy
End With

ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), sixAV).PasteSpecial Paste:=xlPasteFormats
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), sixAV).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Copy in prod 2 wk Gate

With Worksheets("OPERATIONS")
   .Range(.Cells(10, twowk), .Cells(Lrow, twowk)).Copy
End With

ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), twoAV).PasteSpecial Paste:=xlPasteFormats
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), twoAV).PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

End If







Lrow = Sheets("MAINTENANCE").Cells(Rows.Count, 1).End(xlUp).Row
PLANWST = Sheets("MAINTENANCE").Range("9:9").Find(what:="PLANNING WEEK START", lookat:=xlWhole, MatchCase:=False).Column
twowk = Sheets("MAINTENANCE").Range("9:9").Find(what:="2WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
sixwk = Sheets("MAINTENANCE").Range("9:9").Find(what:="6WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
TWELVEWK = Sheets("MAINTENANCE").Range("9:9").Find(what:="12WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
twelveAV = Sheets("ACTIVITY OVERVIEW").Range("2:2").Find(what:="12WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
sixAV = Sheets("ACTIVITY OVERVIEW").Range("2:2").Find(what:="6WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column
twoAV = Sheets("ACTIVITY OVERVIEW").Range("2:2").Find(what:="2WK GATE DATE", lookat:=xlWhole, MatchCase:=False).Column


Application.StatusBar = "Importing Data - Activity Overview (Maintenance)... "

On Error Resume Next
ThisWorkbook.Worksheets("MAINTENANCE").ShowAllData
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Unprotect Password:="Password"
On Error GoTo 90

Lrow2 = Sheets("ACTIVITY OVERVIEW").Cells(Rows.Count, 1).End(xlUp).Row

'Copy in maint workscope


If ThisWorkbook.Sheets("MAINTENANCE").Range("A10", Sheets("MAINTENANCE").Cells(Lrow, TWELVEWK)).SpecialCells(xlCellTypeVisible).Count > 1 Then


Worksheets("MAINTENANCE").Range("A10", Sheets("MAINTENANCE").Cells(Lrow, "N")).Copy

ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), "A").PasteSpecial Paste:=xlPasteFormats
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), "A").PasteSpecial Paste:=xlPasteValues
On Error Resume Next
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), "A").PasteSpecial Paste:=xlPasteComments
On Error GoTo 90
Application.CutCopyMode = False




Worksheets("MAINTENANCE").Range("P10", Sheets("MAINTENANCE").Cells(Lrow, "T")).Copy

ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), "O").PasteSpecial Paste:=xlPasteFormats
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), "O").PasteSpecial Paste:=xlPasteValues
On Error Resume Next
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), "O").PasteSpecial Paste:=xlPasteComments
On Error GoTo 90
Application.CutCopyMode = False




'Copy in prod 12wk gate
With Worksheets("MAINTENANCE")
   .Range(.Cells(10, TWELVEWK), .Cells(Lrow, TWELVEWK)).Copy
End With

ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), twelveAV).PasteSpecial Paste:=xlPasteFormats
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), twelveAV).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

'Copy in prod 6wk Gate

With Worksheets("MAINTENANCE")
   .Range(.Cells(10, sixwk), .Cells(Lrow, sixwk)).Copy
End With

ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), sixAV).PasteSpecial Paste:=xlPasteFormats
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), sixAV).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

'Copy in prod 2 wk Gate

With Worksheets("MAINTENANCE")
   .Range(.Cells(10, twowk), .Cells(Lrow, twowk)).Copy
End With

ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), twoAV).PasteSpecial Paste:=xlPasteFormats
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Cells((Lrow2 + 1), twoAV).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

End If







SCHEDST = Sheets("ACTIVITY OVERVIEW").Range("2:2").Find(what:="SCHEDULED START", lookat:=xlWhole, MatchCase:=False).Column



Lrow = Sheets("ACTIVITY OVERVIEW").Cells(Rows.Count, 1).End(xlUp).Row



ThisWorkbook.Worksheets("ACTIVITY OVERVIEW").AutoFilter.Sort.SortFields.Clear
    ThisWorkbook.Worksheets("ACTIVITY OVERVIEW").AutoFilter.Sort.SortFields.Add Key:= _
        Range(Cells(2, SCHEDST), Cells(Lrow, SCHEDST)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ThisWorkbook.Worksheets("ACTIVITY OVERVIEW").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With








'Adding update info

With ThisWorkbook.Sheets("SETTINGS").Range("I2")
.Value = Now
.NumberFormat = "d/m/yyyy h:mm AM/PM"
End With

With ThisWorkbook.Sheets("WELCOME").Range("L10")
.Value = Now
.NumberFormat = "d/m/yyyy h:mm AM/PM"
End With

Application.DisplayAlerts = False

ThisWorkbook.Save

Application.DisplayAlerts = True




70 GoTo 100
90 MsgBox "Error line: " & Erl & "Error Code: " & Err

ThisWorkbook.Sheets("OPERATIONS").Protect Password:="Password", UserInterfaceOnly:=True, AllowFiltering:=True
ThisWorkbook.Sheets("MAINTENANCE").Protect Password:="Password", UserInterfaceOnly:=True, AllowFiltering:=True
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Protect Password:="Password", UserInterfaceOnly:=True, AllowFiltering:=True
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Range("A1").Select
100 Application.ScreenUpdating = True
Application.EnableEvents = True
Application.StatusBar = False

ThisWorkbook.Sheets("WELCOME").Protect Password:="Password", UserInterfaceOnly:=True, AllowFiltering:=True
ThisWorkbook.Sheets("ACTIVITY OVERVIEW").Protect Password:="Password", UserInterfaceOnly:=True, AllowFiltering:=True
ThisWorkbook.Sheets("CoW PERFORMANCE").Protect Password:="Password", UserInterfaceOnly:=True, AllowFiltering:=True
ThisWorkbook.Sheets("OPERATIONS").Protect Password:="Password", UserInterfaceOnly:=True, AllowFiltering:=True
ThisWorkbook.Sheets("MAINTENANCE").Protect Password:="Password", UserInterfaceOnly:=True, AllowFiltering:=True


Unload UserForm12
On Error Resume Next
Sheets("SETTINGS").Range("Z2") = 1
Application.DisplayAlerts = False
ThisWorkbook.Sheets("OPS PLANNER").Delete
ThisWorkbook.Sheets("MAINT").Delete
Application.DisplayAlerts = True
Application.StatusBar = False
Err.Clear
ThisWorkbook.Sheets("WELCOME").Activate
Sheets("WELCOME").Range("A1").Select

End Sub



I know the code is probably very scrappy!, but it was all working fine until I put a bunch more data into the first book and I think that because it uses so much it is now making it open up a new instance and the macros are failing and it is corrupting the second file too.


Also I need to keep them as separate workbooks, I can't combine them into one.


Any help or pointers would be greatly appreciated.

Many Thanks
Tom
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
You must log in or register to reply here.

Similar threads

M
  • Question Question
Using VBA code in a protected excel sheet
Replies
2
Views
547
MagicCarpet
M
M
  • Question Question
Not running code
Replies
0
Views
218
MagicCarpet
M
S
  • Question Question
Code path
2
Replies
10
Views
290
Jeffrey Mahoney
Jeffrey Mahoney
R
  • Question Question
Compose Email VBA Help
Replies
1
Views
139
Logit
Logit
N
  • Question Question
AutoFilter Field Macro Returns a Header Row only
2
Replies
11
Views
221
MARK858
MARK858

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top