Macro keeps giving debug error

[kingspur06]

I have several tabs which I need to copy paste into a single tab to allow a pivot table to be created on the consolidated information.
I created it by recording it but I constantly get a debug error "Code Execution has been interrupted"
It also doesn't seem to stop at the same place each time.

My macro looks like this

Sub ConsolData()
'
' ConsolData Macro
'
' Keyboard Shortcut: Ctrl+a
'
    Sheets("UK").Select
    Columns("A:BF").Select
    Selection.Copy
    Sheets("Consolidated Data").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A2000").Select
    
    Sheets("Spain").Select
    Range("A2:BF1000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Consolidated Data").Select
    ActiveSheet.Paste
    Range("A2999").Select
    
    Sheets("Europe").Select
    Range("A2:BF1000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Consolidated Data").Select
    ActiveSheet.Paste
    Range("A3998").Select
    
    Sheets("USA").Select
    Range("A2:BF1000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Consolidated Data").Select
    ActiveSheet.Paste
    Range("A4997").Select
    
    Sheets("Archive 22-23").Select
    Range("A2:BF1150").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Consolidated Data").Select
    ActiveSheet.Paste
    
    Sheets("Summary").Select
End Sub

I suspect the issue may be being caused by another macro that I have running which highlights cells whenever a constant value is entered after you have entered that sheet. When I step through my original macro, it always runs through the 2nd macro when going into each sheet.

The 2nd macro is

Option Explicit
Private Sub Worksheet_Activate()
Dim cell As Range
On Error Resume Next
For Each cell In ActiveSheet.Range("o2:aa2000").SpecialCells(xlCellTypeConstants)
cell.Interior.ColorIndex = 17
Next
End Sub

Does anyone have any suggestions, either how to consolidate my sheets into one sheet more elegantly, or how to prevent the bugging?
many thanks
Mark

 

[6StringJazzer]

I'll look at your overall problem but this stuck out right away. Don't color the cells in a loop. SpecialCells returns a Range. This will be hella faster.

Option Explicit
Private Sub Worksheet_Activate()

   ActiveSheet.Range("o2:aa2000").SpecialCells(xlCellTypeConstants).Interior.ColorIndex = 17

End Sub

 

[HaHoBe]

Hi Mark,

deactivate any event at the begin of the code and activate it back again at the end (it will not be activated automaticly):

Sub ConsolData()
'
' ConsolData Macro
'
' Keyboard Shortcut: Ctrl+a
'
    Application.EnableEvents = False
    Sheets("UK").Select
    Columns("A:BF").Select
    Selection.Copy
    Sheets("Consolidated Data").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A2000").Select
    
    Sheets("Spain").Select
    Range("A2:BF1000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Consolidated Data").Select
    ActiveSheet.Paste
    Range("A2999").Select
    
    Sheets("Europe").Select
    Range("A2:BF1000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Consolidated Data").Select
    ActiveSheet.Paste
    Range("A3998").Select
    
    Sheets("USA").Select
    Range("A2:BF1000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Consolidated Data").Select
    ActiveSheet.Paste
    Range("A4997").Select
    
    Sheets("Archive 22-23").Select
    Range("A2:BF1150").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Consolidated Data").Select
    ActiveSheet.Paste
    
    Sheets("Summary").Select
    Application.EnableEvents = True

End Sub

But maybe try the modified (untested) code on a copy of the workbook, code doesn't switch between sheets and will copy the filled area limited by the last entry in Column A and copies it below the present data on Consolidated:

Sub ConsolData_MrE1612213()
'
' ConsolData Macro
'
' Keyboard Shortcut: Ctrl+a
'
    
  Dim rngCopy As Range
  
  With Sheets("UK")
    Set rngCopy = .Range("A2", .Range("BF" & .Range("A" & .Rows.Count).End(xlUp).Row))
  End With
  Sheets("Consolidated Data").Range("A1").Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value
  
  With Sheets("Spain")
    Set rngCopy = .Range("A2", .Range("BF" & .Range("A" & .Rows.Count).End(xlUp).Row))
  End With
  With Sheets("Consolidated Data")
    .Range("A" & .Rows.Count.End(xlUp).Row).Offset(1, 0).Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value
  End With
  
  With Sheets("Europe")
    Set rngCopy = .Range("A2", .Range("BF" & .Range("A" & .Rows.Count).End(xlUp).Row))
  End With
  With Sheets("Consolidated Data")
    .Range("A" & .Rows.Count.End(xlUp).Row).Offset(1, 0).Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value
  End With
  
  With Sheets("USA")
    Set rngCopy = .Range("A2", .Range("BF" & .Range("A" & .Rows.Count).End(xlUp).Row))
  End With
  With Sheets("Consolidated Data")
    .Range("A" & .Rows.Count.End(xlUp).Row).Offset(1, 0).Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value
  End With
  
  With Sheets("Archive 22-23")
    Set rngCopy = .Range("A2", .Range("BF" & .Range("A" & .Rows.Count).End(xlUp).Row))
  End With
  With Sheets("Consolidated Data")
    .Range("A" & .Rows.Count.End(xlUp).Row).Offset(1, 0).Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value
  End With
  
  Sheets("Summary").Select
  Set rngCopy = Nothing

End Sub

Ciao,
Holger

 

[6StringJazzer]

Holger's second example has the ultimate flexibility. The most important thing here is do not Select sheets and ranges just to do copy/paste.

I did this before I saw Holger's post but here is an alternative that is simpler but not as flexible. The key thing is to get rid of all the Selects.

Sub ConsolData()
'
' ConsolData Macro
'
' Keyboard Shortcut: Ctrl+a
'
    Sheets("UK").Columns("A:BF").Copy Sheets("Consolidated Data").Columns("A:BF")
    
    Sheets("Spain").Range("A2:BF1000").Copy Sheets("Consolidated Data").Range("A2000")
    
    Sheets("Europe").Range("A2:BF1000").Copy Sheets("Consolidated Data").Range("A2999")
    
    Sheets("USA").Range("A2:BF1000").Copy Sheets("Consolidated Data").Range("A3998")
    
    Sheets("Archive 22-23").Range("A2:BF1150").Copy Sheets("Consolidated Data").Range("A4997")
    
    Sheets("Summary").Select
    
End Sub

 

[kingspur06]

Thanks you for your responses....On both of these solutions it bugs out at the same place, as soon as it tries to action the "Spain" sheet. I also removed the other macro to see if that was causing the issue but it still behaved the same way.

 

[HaHoBe]

Hi Mark,

just for curiosity: what happens if you run your macro instead? Please check if the sheet is present in the workbook and the spelling (maybe additional blanks) - you did not tell which error occurred (could be #9 subscript out of range).

Ciao,
Holger

 

[kingspur06]

Hi Mark,

just for curiosity: what happens if you run your macro instead? Please check if the sheet is present in the workbook and the spelling (maybe additional blanks) - you did not tell which error occurred (could be #9 subscript out of range).

Ciao,
Holger

The error is "Code Execution has been interrupted"
All sheet names are present and look good.
thanks
Mark

 

[HaHoBe]

Hi Mark,

did you replace the code Worksheet_Activate as Jeff suggested? Did you use CTRL+Break at any time to stop code from running? If so (I know it sounds funny) please save the files and reboot the computer.

Ciao,
Holger

 

[kingspur06]

Hi Mark,

did you replace the code Worksheet_Activate as Jeff suggested? Did you use CTRL+Break at any time to stop code from running? If so (I know it sounds funny) please save the files and reboot the computer.

Ciao,
Holger

I have actually deleted the other macro for now to make sure that was not the reason for the problem. I have not used CTRL+Break at all

 

[kingspur06]

Also...when I use the Step Into function to step through the steps, the error does not come up.
Only when I use the CTRL-A shortcut key