How to locate a range in each worksheet and paste each range into one worksheet

Question

I am attempting to do three things here. Two out of three appear to be working:

1. I am attempting to loop through each worksheet (beginning after the worksheet titled "Cover Sheet"). That seems to be working.

2. Within each worksheet, I am searching for a cell in column D containing "Assigned On". That, too, appears to be working.

3. Beneath that cell, in each worksheet, should be one or more rows of data (contained in columns D through J). I want to copy that data, from each worksheet, into one worksheet called "Due Outs". I cannot get this step to work.

My code is below. I keep getting a runtime 1004 error at match.CurrentRegion.Select because the select method of Range class failed. I have tried several variations, to include Resize and Offset, and keep getting the same error.

Sub macroGetDue()
Dim ws As Worksheet
Dim match As Range
Dim findMe As String
Dim StartIndex As Integer

StartIndex = Sheets("Cover Sheet").Index + 1
findMe = "Assigned on"

For Each ws In Worksheets
If ws.Index > StartIndex Then
    Set match = ws.Range("D:D").Find(findMe).Offset(1)
    match.CurrentRegion.Select
    Selection.Copy
    Sheets("Due Outs").Range("D" & Rows.Count).End(xlUp).Offset(1).Select
    Selection.Paste
End If
Next ws
End Sub

Answer 1

It is always recommended to avoid using Select, you can copy a range to another without using it. Most of the times it fails because the WS is not active.

Better to copy directly like this:

match.CurrentRegion.Copy Sheets("Due Outs").Range("D" & Rows.Count).End(xlUp).Offset(1)