Data Segregation based on number of line items using different sheets

[harinsh]

I’m looking vba code in order to segregate the data as per below requirement.

I have sheet1 which contains the data and required to copy this data till 90 line items including empty rows and needs to paste special in new sheet. This new sheet name should be changed to Setitem1 and it should continue similar like second set of 90 items and new sheet name should be Setitem2.

Example;
In sheet1 there is 180 line items including empty rows and first set of 90 line items should get copy to new sheet name called “Setitem1” and another 90 items should get copy to “setitem2” it goes till number of total line items get copy from the master data.

Hope can anyone help me with this.

Thanks you....

 

[harinsh]

can anyone help me with above requirement ..??

 

[Peter_SSs]

Try this in a copy of your workbook.

Sub CopyToNewSheets()
  Dim lr As Long, i As Long, k As Long
  Dim wsNew As Worksheet
  
  With Sheets("Sheet1")
    lr = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = 1 To lr Step 90
      k = k + 1
      On Error Resume Next
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Setitem" & k
      On Error GoTo 0
      Set wsNew = ActiveSheet
      .Rows(i).Resize(90).Copy Destination:=wsNew.Range("A1")
    Next i
  End With
End Sub

 

[harinsh]

Hi, its working fine....but I want to copy based on like items (including empty rows) not based on row number and need small customization I already have setitem1 sheet which contains the data and need to keep 90 items in this sheet and copy need to start from 91 to till nxt 90 line items and so on.... I need to have empty in A1 row because I'm going to update the headings later on.

Thanks for your help....

 

[harinsh]

sorry, it is working fine....only customization required A1 row headings...I want to include setitem number sheets A1 headings so, macro should paste from A2 and need to paste the headings...could you please help me with this.....Thanks you very much.....

 

[Peter_SSs]

sorry, it is working fine....only customization required A1 row headings...I want to include setitem number sheets A1 headings so, macro should paste from A2 and need to paste the headings...could you please help me with this.....Thanks you very much.....

Try this modification. Changes highlighted in blue.

Sub CopyToNewSheets()
  Dim lr As Long, i As Long, k As Long
  Dim wsNew As Worksheet
  
  With Sheets("Sheet1")
    lr = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = 2 To lr Step 90
      k = k + 1
      On Error Resume Next
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Setitem" & k
      On Error GoTo 0
      Set wsNew = ActiveSheet
      Union(.Rows(1), .Rows(i).Resize(90)).Copy Destination:=wsNew.Range("A1")
    Next i
  End With
End Sub

 

[harinsh]

Great Sir....It is completely working as per my requirement.....I don't have anything to say...except...WOW!!!!!!!!!!!

 

[Peter_SSs]

Glad it is what you wanted.

 

[harinsh]

Hi Peter,

Sorry to troubling you again, one more and last customization added to my task …when macro copy paste 90 items it is considering the empty rows …doing this I have problem because I have data with frequent empty rows in between it is required for upload purpose….

Is there any way to check the empty row at 90^th row …if yes then it should leave it and copy from immediate next row which contains data and copy the same ….later same procedure like earlier.

Thanks

 

[Peter_SSs]

1. Does that mean that the data copied to each sheet, including 'Setitem1', must not be blank in row 2 (headings in row1)?

If so,

2. What do you mean by an "empty row"? Does that mean nothing in column A? Or nothing in all columns? Is there a set number of columns? How many?

3. Just checking that you don't care about blank rows throughout the data, or at the end - it is just blanks at the start that you don't want?