Add to an existing VBA code

[BORUCH]

hi all

i have this vba below

Sub MOVEOVERMERGEDCELLS()
Application.DisplayAlerts = False
Dim myAreas As Areas
Dim sh1 As Worksheet
Dim lr As Long, i As Long, lc As Long, fcel As Long, lcel As Long
Set sh1 = ActiveWorkbook.ActiveSheet
lr = sh1.Cells(Rows.Count, 2).End(xlUp).Row
Set myAreas = sh1.Range("b12:b" & lr).SpecialCells(2).Areas
    For i = 1 To myAreas.Count
        fcel = myAreas(i).Cells(1).Row
        lcel = fcel + myAreas(i).Rows.Count - 1
        lc = Rows(fcel & ":" & lcel).Find("*", , , , 2, 2).Column
        myAreas(i).Offset(, lc - 3).Resize(, 2).Insert Shift:=xlToRight
    Next i
    Application.DisplayAlerts = True
End Sub

which basically does from this below

Daily Promotions V50 12-29-23 MID.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M
12	Item #	Description	Other 1	Other 2	Other 3	Qty	Price	Qty	Price	Qty	Price	Qty	Price
13	00000	test 1				10	$ 12.00	20	$ 11.00	30	$ 10.00
14	00001	test 2
15	00002	test 3
16
17	00004	test 5				9	$ 13.00	25	$ 9.00
18	00005	test 6
19	00006	test 7
20
21	00008	test 9				10	$ 14.00	20	$ 15.66	30	$ 14.00
22
23	00011	test 10				5	$ 100.00	10	$ 90.00
24	00012	test 11
25	00013	test 12
26	00014	test 13
27	00015	test 14
28	00016	test 15
Sheet1

to this

Daily Promotions V50 12-29-23 MID.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M
1
2
3
4
5
6
7
8
9
10
11
12	Item #	Description	Other 1	Other 2	Other 3	Qty	Price	Qty	Price	Qty	Price	Qty	Price
13	00000	test 1				10	$ 12.00	20	$ 11.00			30	$ 10.00
14	00001	test 2
15	00002	test 3
16
17	00004	test 5				9	$ 13.00			25	$ 9.00
18	00005	test 6
19	00006	test 7
20
21	00008	test 9				10	$ 14.00	20	$ 15.66			30	$ 14.00
22
23	00011	test 10				5	$ 100.00			10	$ 90.00
24	00012	test 11
25	00013	test 12
26	00014	test 13
27	00015	test 14
28	00016	test 15
Sheet2

in sheet 2 i have the exact same format what i want is for the vba to find the last group of "qty" "price" in sheet 2 and add it in that space in sheet 1 where the last group was moved over
see example below

Daily Promotions V50 12-29-23 MID.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M
1
2
3
4
5
6
7
8
9
10
11
12	Item #	Description	Other 1	Other 2	Other 3	Qty	Price	Qty	Price	Qty	Price	Qty	Price
13	00000	test 1				10	$ 12.00	20	$ 11.00	from sheet 2	from sheet 2	30	$ 10.00
14	00001	test 2
15	00002	test 3
16
17	00004	test 5				9	$ 13.00	from sheet 2	from sheet 2	25	$ 9.00
18	00005	test 6
19	00006	test 7
20
21	00008	test 9				10	$ 14.00	20	$ 15.66	from sheet 2	from sheet 2	30	$ 14.00
22
23	00011	test 10				5	$ 100.00	from sheet 2	from sheet 2	10	$ 90.00
24	00012	test 11
25	00013	test 12
26	00014	test 13
27	00015	test 14
28	00016	test 15
Sheet2

any help is greatly appreciated

 

[BORUCH]

can someone help out please ?

thanks

 

[BORUCH]

HI

Can someone on this forum please suggest anything

thanks

 

[BORUCH]

hi all

i have this vba below

Sub MOVEOVERMERGEDCELLS()
Application.DisplayAlerts = False
Dim myAreas As Areas
Dim sh1 As Worksheet
Dim lr As Long, i As Long, lc As Long, fcel As Long, lcel As Long
Set sh1 = ActiveWorkbook.ActiveSheet
lr = sh1.Cells(Rows.Count, 2).End(xlUp).Row
Set myAreas = sh1.Range("b12:b" & lr).SpecialCells(2).Areas
    For i = 1 To myAreas.Count
        fcel = myAreas(i).Cells(1).Row
        lcel = fcel + myAreas(i).Rows.Count - 1
        lc = Rows(fcel & ":" & lcel).Find("*", , , , 2, 2).Column
        myAreas(i).Offset(, lc - 3).Resize(, 2).Insert Shift:=xlToRight
    Next i
    Application.DisplayAlerts = True
End Sub

which basically does from this below

Daily Promotions V50 12-29-23 MID.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M
12	Item #	Description	Other 1	Other 2	Other 3	Qty	Price	Qty	Price	Qty	Price	Qty	Price
13	00000	test 1				10	$ 12.00	20	$ 11.00	30	$ 10.00
14	00001	test 2
15	00002	test 3
16
17	00004	test 5				9	$ 13.00	25	$ 9.00
18	00005	test 6
19	00006	test 7
20
21	00008	test 9				10	$ 14.00	20	$ 15.66	30	$ 14.00
22
23	00011	test 10				5	$ 100.00	10	$ 90.00
24	00012	test 11
25	00013	test 12
26	00014	test 13
27	00015	test 14
28	00016	test 15
Sheet1

to this

Daily Promotions V50 12-29-23 MID.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M
1
2
3
4
5
6
7
8
9
10
11
12	Item #	Description	Other 1	Other 2	Other 3	Qty	Price	Qty	Price	Qty	Price	Qty	Price
13	00000	test 1				10	$ 12.00	20	$ 11.00			30	$ 10.00
14	00001	test 2
15	00002	test 3
16
17	00004	test 5				9	$ 13.00			25	$ 9.00
18	00005	test 6
19	00006	test 7
20
21	00008	test 9				10	$ 14.00	20	$ 15.66			30	$ 14.00
22
23	00011	test 10				5	$ 100.00			10	$ 90.00
24	00012	test 11
25	00013	test 12
26	00014	test 13
27	00015	test 14
28	00016	test 15
Sheet2

in sheet 2 i have the exact same format what i want is for the vba to find the last group of "qty" "price" in sheet 2 and add it in that space in sheet 1 where the last group was moved over
see example below

Daily Promotions V50 12-29-23 MID.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M
1
2
3
4
5
6
7
8
9
10
11
12	Item #	Description	Other 1	Other 2	Other 3	Qty	Price	Qty	Price	Qty	Price	Qty	Price
13	00000	test 1				10	$ 12.00	20	$ 11.00	from sheet 2	from sheet 2	30	$ 10.00
14	00001	test 2
15	00002	test 3
16
17	00004	test 5				9	$ 13.00	from sheet 2	from sheet 2	25	$ 9.00
18	00005	test 6
19	00006	test 7
20
21	00008	test 9				10	$ 14.00	20	$ 15.66	from sheet 2	from sheet 2	30	$ 14.00
22
23	00011	test 10				5	$ 100.00	from sheet 2	from sheet 2	10	$ 90.00
24	00012	test 11
25	00013	test 12
26	00014	test 13
27	00015	test 14
28	00016	test 15
Sheet2

any help is greatly appreciated

I'm still looking for help on this one

thanks