VBA Extracting Data whilst moving cells to be in correct format

[Grange2]

Hello,

Im looking to extract data from copied data.

*	3840113	WILLOCHRA	HOME	FOR	THE	AGED
53292	A10(3)	SPAGHETTI	SP	KX571637	1	0.3	0	0.3
61651	420G(24)	SPAGHETTI	KX602106	3	0.15	0	0.15
61659	425G(24)	BAKED	BEAN	KX463001	4	0.2	0	0.2
61659	425G(24)	BAKED	BEAN	KX602106	5	0.25	0	0.25
89228	A10(3)	PEAR	SLICES	KX672838	1	1.2	0	1.2
89244	A10(3)	PEACH	SLICES	KX530250	1	1.2	0	1.2
89244	A10(3)	PEACH	SLICES	KX602106	1	1.2	0	1.2
89252	A10(3)	PEACH	HALVES	KX672838	1	1.2	0	1.2
243566	120GX24	APPLE	APRIC	KX672838	1	8.25	0	8.25
243567	120GX24	APPLE	PEACH	KX393799	1	8.25	0	8.25
243567	120GX24	APPLE	PEACH	KX463001	1	8.25	0	8.25
243567	120GX24	APPLE	PEACH	KX602106	1	8.25	0	8.25
243618	120GX24	APPLE	STRAW	KX530250	1	8.25	0	8.25
*	3840120	BONEHAM	AGED	CARE	SERVICES
63175	A10(3)	DICED	PIE	PE	KX401579	3	2.4	0	2.4
63175	A10(3)	DICED	PIE	PE	KX549874	3	2.4	0	2.4
63175	A10(3)	DICED	PIE	PE	KX680952	3	2.4	0	2.4
89228	A10(3)	PEAR	SLICES	KX470224	3	3.6	0	3.6
90624	A10(3)	APPLE	AND	ST	KX609784	1	0.6	0	0.6
*	3840465	NORTH	EASTERN	COMMUNITY
61651	420G(24)	SPAGHETTI	KX603612	5	0.25	0	0.25
61659	425G(24)	BAKED	BEAN	KX393087	6	0.3	0	0.3
61659	425G(24)	BAKED	BEAN	KX502901	8	0.4	0	0.4
61659	425G(24)	BAKED	BEAN	KX603612	12	0.6	0	0.6
61659	425G(24)	BAKED	BEAN	KX718025	5	0.25	0	0.25
90623	A10(3)	APPLE	AND	PE	KX461937	3	1.8	0	4
90623	A10(3)	APPLE	AND	PE	KX574353	3	1.8	0	8
90623	A10(3)	APPLE	AND	PE	KX673266	3	1.8	0	1
90625	A10(3)	TROPICAL	FRU	KX502901	3	1.8	0	1.8
*	3841541	CORRECTIVE	SERVICES	NSW
53284	A10(3)	BAKED	BEANS	KX498086	3	0.9	0	0.9
53284	A10(3)	BAKED	BEANS	KX538566	3	0.9	0	0.9
53292	A10(3)	SPAGHETTI	SP	KX388282	3	0.9	0	0.9
*	3842718	WHEATFIELDS	INCORPORATED
29865	2.95K(3)	PEAR	AND	M	KX646660	1	0.6	0	5
63175	A10(3)	DICED	PIE	PE	KX531392	3	2.4	0	5
89228	A10(3)	PEAR	SLICES	KX574584	3	3.6	0	3.6

What im looking is to move all the Values beginning with KX end up in the same column (E). I don't require the names of the items (columns B:D). The biggest issue is that some KX values show in column D and some begin in Column F. If it could end up looking like this it would be perfect for my needs.

*	3840113	WILLOCHRA	HOME	FOR	THE	AGED
53292	A10(3)	SPAGHETTI	SP	KX571637	1	0.3	0	0.3
61651	420G(24)	SPAGHETTI		KX602106	3	0.15	0	0.15
61659	425G(24)	BAKED	BEAN	KX463001	4	0.2	0	0.2
61659	425G(24)	BAKED	BEAN	KX602106	5	0.25	0	0.25
89228	A10(3)	PEAR	SLICES	KX672838	1	1.2	0	1.2
89244	A10(3)	PEACH	SLICES	KX530250	1	1.2	0	1.2
89244	A10(3)	PEACH	SLICES	KX602106	1	1.2	0	1.2
89252	A10(3)	PEACH	HALVES	KX672838	1	1.2	0	1.2
243566	120GX24	APPLE	APRIC	KX672838	1	8.25	0	8.25
243567	120GX24	APPLE	PEACH	KX393799	1	8.25	0	8.25
243567	120GX24	APPLE	PEACH	KX463001	1	8.25	0	8.25
243567	120GX24	APPLE	PEACH	KX602106	1	8.25	0	8.25
243618	120GX24	APPLE	STRAW	KX530250	1	8.25	0	8.25
*	3840120	BONEHAM	AGED	CARE	SERVICES
63175	A10(3)	DICED	PIE	KX401579	3	2.4	0	2.4
63175	A10(3)	DICED	PIE	KX549874	3	2.4	0	2.4
63175	A10(3)	DICED	PIE	KX680952	3	2.4	0	2.4
89228	A10(3)	PEAR	SLICES	KX470224	3	3.6	0	3.6
90624	A10(3)	APPLE	AND	KX609784	1	0.6	0	0.6
*	3840465	NORTH	EASTERN	COMMUNITY
61651	420G(24)	SPAGHETTI		KX603612	5	0.25	0	0.25
61659	425G(24)	BAKED	BEAN	KX393087	6	0.3	0	0.3
61659	425G(24)	BAKED	BEAN	KX502901	8	0.4	0	0.4
61659	425G(24)	BAKED	BEAN	KX603612	12	0.6	0	0.6
61659	425G(24)	BAKED	BEAN	KX718025	5	0.25	0	0.25
90623	A10(3)	APPLE	AND	KX461937	3	1.8	0	4
90623	A10(3)	APPLE	AND	KX574353	3	1.8	0	8
90623	A10(3)	APPLE	AND	KX673266	3	1.8	0	1
90625	A10(3)	TROPICAL	FRU	KX502901	3	1.8	0	1.8
*	3841541	CORRECTIVE	SERVICES	NSW
53284	A10(3)	BAKED	BEANS	KX498086	3	0.9	0	0.9
53284	A10(3)	BAKED	BEANS	KX538566	3	0.9	0	0.9
53292	A10(3)	SPAGHETTI	SP	KX388282	3	0.9	0	0.9
*	3842718	WHEATFIELDS	INCORPORATED
29865	2.95K(3)	PEAR	AND	KX646660	1	0.6	0	5
63175	A10(3)	DICED	PIE	KX531392	3	2.4	0	5
89228	A10(3)	PEAR	SLICES	KX574584	3	3.6	0	3.6

Any help would be greatly appreciated!

Thank you.

 

[Zot]

Try This

Sub ReAlign()

Dim cell As Range, rngData As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")
Set rngData = ws1.Range("A1", ws1.Cells(Rows.Count, "A").End(xlUp))

For Each cell In rngData
    ws1.Range("A" & cell.Row, "J" & cell.Row).Copy ws2.Range("A" & cell.Row)
    If Left(ws2.Range("D" & cell.Row), 2) = "KX" Then
        ws2.Range("D" & cell.Row).Insert xlShiftToRight
    ElseIf Left(ws2.Range("F" & cell.Row), 2) = "KX" Then
        ws2.Range("E" & cell.Row).Delete xlShiftToLeft
    End If
Next

End Sub

 

[Grange2]

Thank you Zot! Code works perfectly