Help with find, select and paste

[Matt1989]

Evening all,

I am pretty new to VBA and I could really do with some help with a spread sheet.

I need to copy data from multiple rows (I only need up to offset 0,10 from these rows) when a cell in the range A1:A30000 in the sheet entitled DATA equals the value of TextBox7, to another sheet entitled REVIEW.

The sheet entitled REVIEW is same structure (column headings) as the sheet entitled DATA.

When the data is pasted on the sheet REVIEW I need the first row to be entered on the next empty row then each consecutive row entered after that to be entered on an empty row.

I can’t seem to get any variation of VBA code to do this.

Any help will be greatly received.

 

[JLGWhiz]

(I only need up to offset 0,10 from these rows)

Not sure what this means. When you say "up to" it indicates the copy range could be less than 10 rows, so what determines the number of rows to be copied?

 

[MARK858]

Assuming that it is an ActiveX TextBox and you mean 10 columns across by the Offset (so 11 columns in total) then maybe try...

Sub Filterit()
    Application.ScreenUpdating = False
    
    With Sheets("Data").Range("A1:A30000")
    
        .AutoFilter Field:=1, Criteria1:=Sheets("DATA").OLEObjects("TextBox7").Object.Text
        
        On Error Resume Next
        .Offset(1).Resize(.Rows.Count - 1, 11).SpecialCells(12).Copy _
        Sheets("REVIEW").Range("A" & Rows.Count).End(xlUp).Offset(1)
        On Error GoTo 0
        .AutoFilter
    
    End With
    
    Application.ScreenUpdating = True
End Sub

 

[Matt1989]

Assuming that it is an ActiveX TextBox and you mean 10 columns across by the Offset (so 11 columns in total) then maybe try...

Sub Filterit()
    Application.ScreenUpdating = False
   
    With Sheets("Data").Range("A1:A30000")
   
        .AutoFilter Field:=1, Criteria1:=Sheets("DATA").OLEObjects("TextBox7").Object.Text
       
        On Error Resume Next
        .Offset(1).Resize(.Rows.Count - 1, 11).SpecialCells(12).Copy _
        Sheets("REVIEW").Range("A" & Rows.Count).End(xlUp).Offset(1)
        On Error GoTo 0
        .AutoFilter
   
    End With
   
    Application.ScreenUpdating = True
End Sub

Thanks a lot this worked

 

[MARK858]

You're welcome