How to copy data after at a fixed cell

Solved
skprma
Posts
1
Registration date
Tuesday March 29, 2022
Status
Member
Last seen
March 29, 2022
- Updated on Mar 29, 2022 at 06:56 AM
 skprma - Apr 13, 2022 at 11:47 AM
Hello,

I have the following data for which it needed to be copied on another sheet after a gap of 7 cells for each entry in Sr No. column.

Like first entry is of 6 lines, the second entry is of 5 lines and the third entry is of 6 lines.

I want to copy these entries to another sheet every 8 rows.

Please help.


Sr No. Awb No. Shipper Consignee Tpcs bag_wt Content USD
1 9600127261 KULWINDER KAUR MR G KAUR 1 25.40 SPX OF 15,250.00
1 REHMANPUR 112 ROSEMARY CRESCENT WEST GOLDTHORN PARK LADIES SUITS LADIES DRESS DUPATTA
JALANDHAR GOLDTHORN PARK
WOLVERHAMPTON WEST MIDLANDS
UK WV45AN
Tel#44750XXXXXXX
2 960015509 AMANJOT SINGH KALDIP BANSAL 1 3.60 SPX OF 3,650.00
1 APRA 12 BODIAM DRIVE MUSICAL INSTRUMENT WRIST WATCH GLASS GUARD PHONE COVER SAFETY PINS PKT
JALANDHAR TOOTHILL SWINDON
UK SN58BB
Tel#44786XXXXXXX
3 960012924 RADHA 1 17.25 SPX OF 8,290.00
2 H NO 45 A HARI NAGAR ASHRAM SAVINDER KAURA LIPISTIC GOLGAPHA LADIES SUITS PILLOW TABLE COVERS
NEW DELHI 8 ELLINGTON ROOD
LONDON DIM WT 69 KG
UK TW3 4HY
Tel#44 786XXXXXXX
4 960011495 JASPAL SINGH RIAT 1 10.70 SPX OF 12,700.00
2 NEAR DAV PUBLIC SCHOOL SAIFABAD INDERJEET KAUR LADIES DRESS LADIES UPPER JAMPER BLOUSE DUPATTA
PHILAUR 76 BEATTYVILLE GARDENS
BARKINGSIDE ILFORD ESSEX
UK IG61JZ
Tel#7932XXXXXX
5 2950047790 HANSRAJ 1 9.60 SPX OF 9,500.00
3 BACHHOWAL KULJIT KAUR BAINS BEDSHEET CATTLE SWEATER WRIST BAND CERAMIC BOWL CUP
JALANDHAR 7 BELMORE AVENUE UNSTICH SUIT INNER WEARS
HAYES MIDDX
UK UB40RB
Tel#2085XXXXXXX

System Configuration: Windows / Chrome 99.0.4844.82

1 reply

TrowaD
Posts
2880
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
May 2, 2022
510
Apr 12, 2022 at 12:12 PM
Hi Skprma,

I noticed that each entry start with a number that increases with each entry. When this number is a single value in column A (to determine the beginning and the end of an entry) AND column A doesn't contain empty cells (to determine the last row used), then you can give the code below a try:
Sub RunMe()
Dim lRow, fcRow, lcRow, x, y As Long

Sheets("Sheet1").Select

lRow = Range("A1").End(xlDown).Row
x = 2
y = 2
fcRow = 2

For Each cell In Range("A2:A" & lRow)
    If cell.Value = x Then
        lcRow = cell.Row - 1
        Rows(fcRow & ":" & lcRow).Copy Sheets("Sheet2").Rows(y)
        fcRow = cell.Row
        x = x + 1
        y = y + 8
    End If
Next cell
Rows(fcRow & ":" & lRow).Copy Sheets("Sheet2").Rows(y)
End Sub


Note that in the code, the source sheet is called 'Sheet1' and the destination sheet is called 'Sheet2'.

Best regards,
Trowa

1
Hi Trowa,

This worked perfectly, thanks a ton!
1