简体   繁体   中英

VBA Excel Script - Runtime Error 424 (Code Specific)

By no means am I a VBA developer, but any help on why this isn't working would be greatly appreciated...

Problem:

  1. Analyze all worksheets, except the last.
  2. Check if a column I and J contain an X, if they do, get that row and copy it to the last worksheet.

Error Highlighted is at this line: For Each ws In Workbook.Worksheets . I'm not sure why.

Below is my code, but it's not compiling, and giving me the error code 424 - Object Required.

Sub CopyData()

Application.ScreenUpdating = False
Dim pasteSheet As Worksheet

Set pasteSheet = Worksheets("Remediation Summary")

For Each ws In ThisWorkbook.Worksheets
If ws.Index < (ThisWorkbook.Worksheets.Count - 1) Then
'check column i for x
For Each icell In ws.Range("i1:i200").Cells
If icell.Value Like ("X") Or ("x") Then
    Rows(icell.RowIndex).Copy
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End If
Next icell

'check column j for x
For Each jcell In ws.Range("j1:j200").Cells
If jcell.Value Like ("X") Or ("x") Then
    Rows(jcell.RowIndex).Copy
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End If
Next jcell
End If
Next ws

End Sub

Option Explicit is really a great helper - write it on the top of every module / class / worksheet. It would tell immediately, if there is some variable, which is not declared.

In your case, ws should be declared as a worksheet, as far as you are using the for-each loop to go through the Worksheets collection:

Option Explicit

Sub CopyData()

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        Debug.Print ws.Name
    Next ws

End Sub

Option Explicit MSDN


Concerning this part - If icell.Value Like ("X") Or ("x") Then , consider rewriting it like this:

If UCase(icell) = "X" Then . It would be more understandable and Like is not needed when the comparison is without some additional signs ?* .

Excel VBA like operator

updated codebase:

Sub CopyData()

Application.ScreenUpdating = False
Dim pasteSheet As Worksheet

Set pasteSheet = Worksheets("Remediation Summary")

For Each ws In ThisWorkbook.Worksheets
If ws.Index < (ThisWorkbook.Worksheets.Count - 1) Then
    'check column i for x
    For Each icell In ws.Range("i0:i200").Cells
    If icell.Value Like ("X") Or ("x") Then
        Rows(icell.RowIndex).Copy
        pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End If
    Next icell

    'check column j for x
    For Each jcell In ws.Range("j0:j200").Cells
    If jcell.Value Like ("X") Or ("x") Then
        Rows(jcell.RowIndex).Copy
        pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End If
    Next jcell
End If
Next ws

End Sub

Based on my test, please try the code below:

Option Explicit
Sub CopyData()

Application.ScreenUpdating = False
Dim pasteSheet As Worksheet
Dim ws As Worksheet
Dim icell As Range
Dim jcell As Range
Set pasteSheet = Worksheets("Remediation Summary")

For Each ws In ThisWorkbook.Worksheets
If ws.Index < (ThisWorkbook.Worksheets.Count - 1) Then
'check column i for x
For Each icell In ws.Range("i1:i200").Cells
If UCase(icell) = "X" Or UCase(icell) = "x" Then
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Value = icell.EntireRow.Value
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End If
Next icell

'check column j for x
For Each jcell In ws.Range("j1:j200").Cells
If UCase(jcell) = "X" Or UCase(jcell) = "x" Then
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Value = jcell.EntireRow.Value
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End If
Next jcell
End If
Next ws

End Sub
Sub CopyData()

    Dim pasteSheet As Worksheet, ws As Worksheet, icell As Range
    Set pasteSheet = Worksheets("Remediation Summary") 'ThisWorkbook?

    For Each ws In ThisWorkbook.Worksheets
        If ws.Index < (ThisWorkbook.Worksheets.Count - 1) Then
            'check column i,j for x
            For Each icell In ws.Range("i1:i200").Cells
                If LCase(icell.Value) = "x" Or LCase(icell.Offset(0, 1).Value) = "x" Then
                    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Value = _
                                    icell.EntireRow.Value
                End If
            Next icell
        End If
    Next ws

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM