Using FIND and copying each result to a new worksheet

[chazrab]

This standard FIND and FINDNEXT code block works well and correctly every time in finding any value in any column of any sheet
and gets its values from the userform shown which has Textbox1 for any value of x and Combobox1 for a selection of which Worksheet to select

  Dim x As String
  Dim y As Variant
  Dim c As Range
  x = Me.TextBox1.value
  y = Me.ComboBox1.value
   'On Error Resume Next
    With Worksheets(y).Range("D1:D500")
      Set c = .FIND(x, LookIn:=xlValues)
        If Not c Is Nothing Then
           firstaddress = c.Address
             Do
              Worksheets(y).Visible = True
              Worksheets(y).Select
              c.Select
              MsgBox "Value found in cell " & c.Address
              Range(Cells(c, 1), Cells(c, 9)).copy  ---------->  (I get a 'type mismatch error here) - Why ? This just says to copy cols 1 to 9 of x.
'              Sheets("REPORT2").Select Sheets("REPORT2").Range("A2")
              Set c = .FindNext(c)
             Loop While Not c Is Nothing And c.Address <> firstaddress
        End If
    End With
End If

Once each value of x is found, I jut want to copy that row from column 1 to column 9 to a new sheet(REPORT2) starting in cell A2 of sheet REPORT2
I'm having trouble with the correct copy code to do this. The images are below.
Please help with this if you can. Thanks cr

 

[GWteB]

You might try ...

Sub chazrab()

    Dim x As String
    Dim y As Variant
    Dim c As Range
    Dim FirstAddress As String
    Dim rw As Long
    
    x = Me.TextBox1.Value
    y = Me.ComboBox1.Value
    'On Error Resume Next
    With Worksheets(y).Range("D1:D500")
        Set c = .Find(x, LookIn:=xlValues)
        If Not c Is Nothing Then
        
            ' Added
            rw = 2                                      '
            
            FirstAddress = c.Address
            Do
                Worksheets(y).Visible = True
                Worksheets(y).Select
                c.Select
                MsgBox "Value found in cell " & c.Address
'                Range(Cells(c, 1), Cells(c, 9)).Copy  ' ---------->  (I get a 'type mismatch error here) - Why ? This just says to copy cols 1 to 9 of x.

                ' changed
                Range(Cells(c.Row, 1), Cells(c.Row, 9)).Copy Destination:=Sheets("REPORT2").Range("A" & rw)
                ' Added
                rw = rw + 1
                
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
        End If
    End With
End Sub

 

[chazrab]

You might try ...

Sub chazrab()

    Dim x As String
    Dim y As Variant
    Dim c As Range
    Dim FirstAddress As String
    Dim rw As Long
   
    x = Me.TextBox1.Value
    y = Me.ComboBox1.Value
    'On Error Resume Next
    With Worksheets(y).Range("D1:D500")
        Set c = .Find(x, LookIn:=xlValues)
        If Not c Is Nothing Then
       
            ' Added
            rw = 2                                      '
           
            FirstAddress = c.Address
            Do
                Worksheets(y).Visible = True
                Worksheets(y).Select
                c.Select
                MsgBox "Value found in cell " & c.Address
'                Range(Cells(c, 1), Cells(c, 9)).Copy  ' ---------->  (I get a 'type mismatch error here) - Why ? This just says to copy cols 1 to 9 of x.

                ' changed
                Range(Cells(c.Row, 1), Cells(c.Row, 9)).Copy Destination:=Sheets("REPORT2").Range("A" & rw)
                ' Added
                rw = rw + 1
               
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
        End If
    End With
End Sub

Works great!. How simple. Thanks GWteB

 

[GWteB]

You are welcome and thanks for letting me know.