Copy/paste range in stead of row

[Brutusar]

Hi,

I am using this code to search thru a sheet looking for a value in a column, and if found, copy the row to a different sheet. However, when the value is found it is a range, not only a single row. That means I need to replace the "Cells" in this code, Cells(x, 1).Resize(1, 33).Copy, with "Range". Or at least I thought so, but that is not working. What am I doing wrong? Second question, when the range has been copied I would like to find the second range if any. Do I need to add in the "FindNext" before the Elseif, or after? (I Can't get that to work either...)


Full VBA code below:

Public Sub FindCopy()
Sheets("Sheet1").Select
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To FinalRow
ThisValue = Cells(x, 4).Value
If ThisValue = "Agro" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("Sheet2").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Sheet2").Select
ElseIf ThisValue = "Vegro" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("Sheet3").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Sheet3").Select
End If
Next x
End Sub

 

[My Aswer Is This]

Explain what the range is.
You said not a single row.

Here you show:

if ThisValue = "Agro" Then

so what range do you want to copy​

 

[Brutusar]

Hi,

Sorry, that was very unprecise from my side! What I wish to use is: CurrentRegion

 

[My Aswer Is This]

Hi,

Sorry, that was very unprecise from my side! What I wish to use is: CurrentRegion

Sorry I never use current region so:
This is beyond my knowledgebase.
I will continue to monitor this thread to see what I can learn.

 

[Roger Govier]

HI
I would just filter and copy to the other sheets.
Insert a few rows at the top of your sheet 1, so the header is now in row 4
Whatever your heading is for column 4, type that into cell E1 (in my example) and enter Agro into cell E2

Sub FilterCopyToOtherSheet()
  
Sheets("Sheet1").Select
Sheets("Sheet1").Range("E2")= "Agro"
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row 
    Sheets("Sheet1").Range("A4:AG7" & Finalrow).AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Sheet1").Range("E1:E2"), _
        CopyToRange:=Sheets("Sheet2").Range("A1"), _
        Unique:=False
Sheets("Sheet1").Select

Sheets("Sheet1").Range("E2")= "Vegro"
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row 
    Sheets("Sheet1").Range("A4:AG7" & Finalrow).AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Sheet1").Range("E1:E2"), _
        CopyToRange:=Sheets("Sheet3").Range("A1"), _
        Unique:=False
 
End Sub

 

[Brutusar]

Thanks, that is an approach I did not think of at all. Will check it out!