Avoid paste error if nothing was copied.

  • Thread starter Thread starter J.W. Aldridge
  • Start date Start date
J

J.W. Aldridge

I run three consecutive codes named consolidate 1, 2, then 3.
Using the example below, I get an error if the copy range has no
data.
What is the best way to rewrite this or somehow avoid the error if
there is no data.
I want it to simply move on to the next step if there's nothing to
copy and or paste.

Sub Consolidate1()
Sheets("apples").Select
Range("a2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Summary").Select
Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.Goto Selection.Cells(1)
End Sub
 
Sub Consolidate1()

Application.ScreenUpdating = False

Sheets("apples").Select

Range("a2").Select

Range(Selection, Selection.End(xlDown)).Select

Range(Selection, Selection.End(xlToRight)).Select


Selection.Copy

Sheets("Summary").Select

Range("A65536").End(xlUp).Select


ActiveCell.Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.Goto Selection.Cells(1)

End Sub

_______________________________
Sub Consolidate2()

Application.ScreenUpdating = False

Sheets("cherries").Select

Range("a2").Select

Range(Selection, Selection.End(xlDown)).Select

Range(Selection, Selection.End(xlToRight)).Select


Selection.Copy

Sheets("Summary").Select

Range("A65536").End(xlUp).Select


ActiveCell.Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.Goto Selection.Cells(1)

End Sub
____________________________
Sub Consolidate3()

Application.ScreenUpdating = False

Sheets("grapes").Select

Range("a2").Select

Range(Selection, Selection.End(xlDown)).Select

Range(Selection, Selection.End(xlToRight)).Select


Selection.Copy

Sheets("Summary").Select

Range("A65536").End(xlUp).Select

ActiveCell.Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.Goto Selection.Cells(1)

End Sub
 
Use error trapping to skip the paste if it fails:

Sub Consolidate1()
Sheets("apples").Select
Range("a2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Summary").Select
Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
On Error Resume Next ' <<==== Skip the next line if it errors out
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
On Error GoTo 0 ' <<==== Turn off error trapping
Application.Goto Selection.Cells(1)
End Sub

HTH,

Eric
 
This should be a bit more efficient. Run from anywhere in the workbook

Option Explicit
Sub copytosummary()
Dim dlr, slr, slc As Long
Dim ws As Worksheet

For Each ws In Worksheets
dlr = Sheets("summary"). _
Cells(Rows.Count, 1).End(xlUp).Row + 1
If ws.Name <> "Summary" Then
With ws
slr = .Cells(Rows.Count, "a").End(xlUp).Row
slc = .Cells(slr, "a").End(xlToRight).Column
.Cells(2, 1).Resize(slr, slc).Copy _
Sheets("Summary").Cells(dlr, 1)
End With
End If
Next ws
End Sub
 
Back
Top