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 :-

[TABLE="width: 64"]
<tbody>[TR]
[TD="width: 64"]abb[/TD]
[/TR]
[TR]
[TD]bcd[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
The sheet 2 would be having having data in the following format :-

[TABLE="width: 192"]
<tbody>[TR]
[TD="width: 64"]Name[/TD]
[TD="width: 64"]Status[/TD]
[TD="width: 64"]location[/TD]
[/TR]
[TR]
[TD]abb[/TD]
[TD]Not Required[/TD]
[TD]new york[/TD]
[/TR]
[TR]
[TD]abb[/TD]
[TD][/TD]
[TD]france[/TD]
[/TR]
[TR]
[TD]bcd[/TD]
[TD][/TD]
[TD]france[/TD]
[/TR]
[TR]
[TD]bcd[/TD]
[TD][/TD]
[TD]france[/TD]
[/TR]
[TR]
[TD]fgh[/TD]
[TD][/TD]
[TD]france[/TD]
[/TR]
[TR]
[TD]ty[/TD]
[TD][/TD]
[TD]france[/TD]
[/TR]
[TR]
[TD]hu[/TD]
[TD][/TD]
[TD]germany[/TD]
[/TR]
[TR]
[TD]ty[/TD]
[TD]Not Required[/TD]
[TD]germany[/TD]
[/TR]
[TR]
[TD]fgh[/TD]
[TD][/TD]
[TD]germany[/TD]
[/TR]
[TR]
[TD]op[/TD]
[TD][/TD]
[TD]germany[/TD]
[/TR]
[TR]
[TD]er[/TD]
[TD][/TD]
[TD]germany
[/TD]
[/TR]
</tbody>[/TABLE]
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