Copy rows from one sheet to another based on a list

[ajilthomas]

Hi

I am trying to create a macro which would copy the entire row of data from one sheet based on the a list of values in another sheet, additionally it should remove any rows which might have the value of not required. The sheet 1 will have the below values :-

abb

bcd

<tbody>
</tbody>

The sheet 2 would be having having data in the following format :-

Name	Status	location
abb	Not Required	new york
abb		france
bcd		france
bcd		france
fgh		france
ty		france
hu		germany
ty	Not Required	germany
fgh		germany
op		germany
er		germany

<tbody>
</tbody>

The final data would look something like below

abb <space> France
bcd <space> France
bcd <space> France


Have been able to use something like below :-

Sub MoveRowBasedOnCellValue()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("CMDB").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("CMDB").Range("A1:A" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Done" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub

however not able to replace "done" with the list, please help.

Thanks</space></space></space>

 

[Fluff]

The problem is that in your op you showed col B as having either Not Required or blank. Whereas your file is either Not required or Required.
Try this

Sub CopyFltr()

    Dim Ary As Variant
    Dim UsdRws As Long
    
    Ary = Application.Transpose(Sheets("Sheet1").Range("A1").CurrentRegion)
    With Sheets("Sheet2")
        If .AutoFilterMode Then .AutoFilterMode = False
        UsdRws = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A1").AutoFilter 1, Ary, xlFilterValues
        .Range("A1").AutoFilter 2, "Required"
        .Range("A2:C" & UsdRws).SpecialCells(xlVisible).Copy Sheets("sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1)
        .AutoFilterMode = False
    End With
    
End Sub