Macro to copy contents of one page to another results in runtime error 1004

**RyanAkers** · 03-23-2010, 06:33 PM

I'm trying to build a code, to be run from a button, that copys the contents of one sheet and pastes it in another, then runs a code that deletes any rows that do not meet my specified criteria.

I recorded a macro that does the copy paste function, which runs fine on its own, and i have the code that deletes the rows, on its own, with runs fine. If I put the copy code in before the delete code, we get runtime error 1004.

Here is the code that is giving me grief:

Private Sub CommandButton1_Click()
    Sheets("Sheet2").Select
    Range("B2:D170").Select
    Range("D170").Activate
    Selection.Copy
    Sheets("Sheet1").Select
    Range("B2").Select
    ActiveSheet.Paste
    
    Dim rng As Range
    Dim del As Range
    Dim cell As Range
    Dim strCellValue As String
    Set rng = Intersect(Range("D2:D170"), ActiveSheet.UsedRange)
    For Each cell In rng
        strCellValue = (cell.Value)
        If InStr(strCellValue, "0") = 1 Then
            If del Is Nothing Then
                Set del = cell
            Else: Set del = Union(del, cell)
            End If
        End If
    Next cell
    On Error Resume Next
    del.EntireRow.Delete
End Sub

The line with "Range("B2:D170").Select" is the line that becomes highlighted when the debug button is pressed.
I have searched google extensively for a solution, but all seem to be irrelevant to my job.

Could i call the prerecorded macro from the button, before the delete code is run? How would i do this?

Regards,
Ryan Akers

**romperstomper** · 03-23-2010, 06:38 PM

It appears you have the code in a worksheet module. If so, when you have a Range call that is unqualified by a worksheet, it actually refers to the range on the worksheet containing the code, and since that sheet is not active, you cannot select a range on it. However, you don't need to select anything here anyway:

Private Sub CommandButton1_Click()

    Dim rng As Range
    Dim del As Range
    Dim cell As Range
    Dim strCellValue As String
    Dim wks as Worksheet

   Set wks = Sheets("Sheet1")
    Sheets("Sheet2").Range("B2:D170").Copy Destination:=wks.Range("B2")
    

    Set rng = Intersect(wks.Range("D2:D170"), wks.UsedRange)
    For Each cell In rng
        strCellValue = (cell.Value)
        If InStr(strCellValue, "0") = 1 Then
            If del Is Nothing Then
                Set del = cell
            Else: Set del = Union(del, cell)
            End If
        End If
    Next cell
    On Error Resume Next
    del.EntireRow.Delete
End Sub