ajilthomas
New Member
- Joined
- Oct 5, 2011
- Messages
- 8
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 :-
<tbody>
</tbody>The sheet 2 would be having having data in the following format :-
<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>
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>
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>
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>