How to copy data after at a fixed cell

Solved/Closed
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
Related:

1 response

TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
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

Hi Trowa,

This worked perfectly, thanks a ton!