delete new items in sheet and arrange again to put into adjacent cells

[MKLAQ]

Hi
I want matching items in column B between two sheets . if the item is existed in first sheet but not existed in second sheet then should delete the new item from first sheet and should arrange again to put each item for firs sheet is adjacent cell for second sheet
my data could be 5000 rows.

R (1).xlsm
	A	B
1	ITEM	GOODS
2	1	QQW-13 CLA13 TR
3	2	QQW-10 BN CLA10 IT -MM
4	3	QQW-11 LVD CH
5	4	CR CCR-1
6	5	QQW-12 CLA12 JA
7	6	CCR-2
8	7	CCM
9	8	CCB-2
10	9	TR CCB-3
11	10	CCV-9
12	11	CCB-1
13	12	QQW-8 CLA8 UK
14	13	QQW-9 CLA9 N BR
15	14	QQW-10 BN CLA10 IT
16	15	CVF8
17	16	CR CCR-1
18	17	QQW-13 CLA11 TR
19	18	TR CCB-3
20	19	QQW-14 L/R CLA14 SS230 EG
21	20	QQW-15 CLA5 EG
SDE

R (1).xlsm
	A	B	C	D
1	ITEM	GOODS	QTY1	QTY2
2	1	CR CCR-1	12	1
3	2	QQW-10 BN CLA10 IT -MM	66	11
4	3	QQW-11 LVD CH	77	11
5	4	QQW-12 CLA12 JA	88	22
6	5	CCR-2	45	22
7	6	CCB-2	11	1
8	7	TR CCB-3	44	11
9	8	CCB-1	12	11
10	9	QQW-8 CLA8 UK	12	11
11	10	QQW-9 CLA9 N BR	33	22
12	11	QQW-10 BN CLA10 IT	44	22
13	12	CR CCR-1	1203	45
14	13	TR CCB-3	23	6
15	14	QQW-13 CLA13 TR	99	33
16	15	QQW-13 CLA11 TR	66	44
17	16	QQW-14 L/R CLA14 SS230 EG	33	22
18	17	QQW-15 CLA5 EG	22	22
FGH

result

R (1).xlsm
	A	B
1	ITEM	GOODS
2	1	CR CCR-1
3	2	QQW-10 BN CLA10 IT -MM
4	3	QQW-11 LVD CH
5	4	QQW-12 CLA12 JA
6	5	CCR-2
7	6	CCB-2
8	7	TR CCB-3
9	8	CCB-1
10	9	QQW-8 CLA8 UK
11	10	QQW-9 CLA9 N BR
12	11	QQW-10 BN CLA10 IT
13	12	CR CCR-1
14	13	TR CCB-3
15	14	QQW-13 CLA13 TR
16	15	QQW-13 CLA11 TR
17	16	QQW-14 L/R CLA14 SS230 EG
18	17	QQW-15 CLA5 EG
SDE

 

[bebo021999]

I am not understand what it means: "arrange again to put each item for firs sheet is adjacent cell for second sheet"
But below code yields exactly your expected output:

Option Explicit
Sub test()
Dim lr&, i&, k&, rng, arr(1 To 10000, 1 To 2), searchRange As Range
With Worksheets("SDE")
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    Set searchRange = .Range("B2:B" & lr)
End With
With Worksheets("FGH")
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    rng = .Range("A2:B" & lr).Value
    For i = 1 To lr - 1
        If WorksheetFunction.CountIf(searchRange, rng(i, 2)) Then
            k = k + 1
            arr(k, 1) = rng(i, 1): arr(k, 2) = rng(i, 2)
        End If
    Next
End With
With Worksheets("SDE")
    .Range("A2:B10000").ClearContents
    .Range("A2").Resize(k, 2).Value = arr
End With
End Sub

 

[MKLAQ]

much great!
much thanks for your help