View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
J. Cornor J. Cornor is offline
external usenet poster
 
Posts: 6
Default For-Each-Next Freezes Excel

I have 2 workbooks open; a source book and a destination book. The source
book has several worksheets where I select several rows of data from each
worksheet to copy and paste to the destination book. The code I use to do
this is as follows:
( It does exactly what it is supposed to do, perfectly... but when the code
is done and I close the source workbook, the destination book is froze and if
I try to click in the spreadsheet I get one of those "Excel has experienced
some problem" and forces me to close it) What am I missing in my code to
prevent this?

Sub Append()
Application.ScreenUpdating = False
Application.EnableEvents = False

'Prepare destination workbook to receive selected rows of data.
PrepDestBook

'Check each worksheet for selected items.
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
If ws.Range("CheckedBoxes").Value 0 Then ws.Select

'Copy each selected item and paste them in the destination workbook.
GetItemsAndAppend

'Reset selected items to unselected.
ResetLinks

Next ws

Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Sub PrepDestBook()
Dim x As Integer
Dim y As Integer

y = Worksheets(1).Range("M3").Value

ActiveWindow.ActivateNext
Range("RowInsertPoint").Select
x = ActiveCell.Row
If Range("A6").Value < 1 Then
Range(x & ":" & y + x - 2).EntireRow.Insert
Else: Range(x & ":" & y + x - 1).EntireRow.Insert
End If
x = 0
y = 0
ActiveWindow.ActivateNext
End Sub

Sub GetItemsAndAppend()
Dim Cel As Range
For Each Cel In Range("CheckBoxLinks")
If Cel.Value = True Then
Cel.Offset(0, -12).Range("A1:K1").Copy

ActiveWindow.ActivateNext
Range("RowInsertPoint").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Select
ActiveWindow.ActivateNext
End If
Next Cel
End Sub

Sub ResetLinks()
Dim Cel As Range
For Each Cel In Range("CheckBoxLinks")
If Cel.Value = True Then
Cel.Value = False
End If
Next Cel
End Sub

Your help is much appreciated,
Thank You