how to copy data after at a fixed cellSolved/Closed

Question

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

TrowaD · Answer

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

How to copy data after at a fixed cell

1 response

Similar discussions

Subscribe To Our Newsletter!