J
J. Cornor
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
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