vba for copy and paste data to above row

[Vishaal]

We have the following data, and want to copy and paste as per result sheet,

Data

ACTIVE SUBSCRIBER.XLSX
	A	B	C	D	E
20	70986	SHUTBJT	NEFT	10/30/21	987453.00
21		FDSFJDSFLDSJFSDKLSDHFDSHFHASDFDSFDSFSDF	1-Dec-21	1-Nov-22
22			TEL	DFDSFS
23	980874	AHDFDF	PUM	11/1/21	98765.00
24		DFSFD FDSFSDF 433535353535	1-Dec-21	1-Nov-22
25		Email: raghib1993@gmail.com	OB: 8209043164	PUM
Sheet1

result data

ACTIVE SUBSCRIBER.XLSX
	A	B	C	D	E	F	G	H	I	J	K
20	70986	SHUTBJT	NEFT	10/30/21	987453.00	FDSFJDSFLDSJFSDKLSDHFDSHFHASDFDSFDSFSDF	1-Dec-21	1-Nov-22		TEL	DFDSFS
21
22
23	980874	AHDFDF	PUM	11/1/21	98765.00	DFSFD FDSFSDF 433535353535	1-Dec-21	1-Nov-22	Email: raghib1993@gmail.com	OB: 8209043164	PUM
Sheet1

 

[RobP]

Hi maybe this code can help you , assuming data is in col A as you have it, and starts row 1 (else adjust the count 1 to LR to 2 to LR, or 3 to LR etc..)

Sub move_data()

Dim LR, RC As Long

LR = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row  ' check col 2 for last row of data

For RC = 1 To LR

    If ActiveSheet.Cells(RC, 1) <> "" Then 'check if column A has a value (ie. is the first line in the set of 3)
    
        ActiveSheet.Range(Cells(RC + 1, 2), Cells(RC + 1, 4)).Cut (ActiveSheet.Range(Cells(RC, 6), Cells(RC, 8)))
        ActiveSheet.Range(Cells(RC + 2, 2), Cells(RC + 2, 4)).Cut (ActiveSheet.Range(Cells(RC, 9), Cells(RC, 11)))
        
    End If

Next RC

End Sub

 

[Vishaal]

Thank you very much RobP

 

[RobP]

youre welcome

thanks for the feedback

Rob