Copy certain row to new sheet

[miracleyy]

Dear all,

i would like to copy each new order start from row "PH Order No:" to "0" to new sheet.
for below example, i would like to separate 4 order to 4 sheet.

Please help!!!

 

[hiker95]

miracleyy,

Thanks for the workbook.

In the future when asking for help, please display before, and, screenshots, or, attach a workbook as you did on your last reply #20.

This way we can normally find a solution on the first go.

Be back later with an update.

 

[hiker95]

miracleyy,

Thanks for the workbook.

Sample raw data for one order number in worksheet Sheet1:

Excel 2007
	A	B	C	D	E	F	G	H	I	J
1	Pick No:	10056915	Order No:	10048992	Customer Name:	P-ASLCK	STORE (Location A )
2	Product Code	Picking Qty	Total PCE	no.	Product name	StorCond	CS	PK	PCE	InvType
3	10011002	SANKO 24pcs	1	Ambient	Normal	12X1	3	0	0	404-HLC
4	10013522	URASHIMA 6g	2	Ambient	Normal	2X30	1	1	0	404-HLC
5	10213002	SUNTORY 420ml	3	Ambient	Normal	24X1	2	0	0	5F02-01-070
6	6	1	0	36.70	0.213000	174	Total:
Sheet1

After the macro in two of the new worksheets:

Excel 2007
	A	B	C	D	E	F	G	H	I	J
1	Pick No:	10056915	Order No:	10048992	Customer Name:	P-ASLCK	STORE (Location A )
2	Product Code	Picking Qty	Total PCE	no.	Product name	StorCond	CS	PK	PCE	InvType
3	10011002	SANKO 24pcs	1	Ambient	Normal	12X1	3	0	0	404-HLC
4	10013522	URASHIMA 6g	2	Ambient	Normal	2X30	1	1	0	404-HLC
5	10213002	SUNTORY 420ml	3	Ambient	Normal	24X1	2	0	0	5F02-01-070
6	6	1	0	36.70	0.213000	174	Total:
7
10048992

Excel 2007
	A	B	C	D	E	F	G	H	I	J
1	Pick No:	10048726	Order No:	10048996	Customer Name:	P-ASTKO	STORE (Location E )
2	Product Code	Picking Qty	Total PCE	no.	Product name	StorCond	InvType	Packing	Location	Lot Number
3	10044422	NABISCO 13PCSx3PK	1	Ambient	Normal	8X6	1	0	0	404-HLC
4	10555552	ITOU 90g	2	Ambient	Normal	20X1	2	0	0	404-HLC
5	10441002	EBARA 245ml	3	Ambient	Normal	20X1	2	0	0	404-HLC
6	10013522	URASHIMA8PCS	4	Ambient	Normal	2X12	5	0	0	404-HLC
7	10213002	MEIJI 9PCS	5	Ambient	Normal	30X1	1	0	0	404-HLC
8	10011002	MEIJI 9PCS	6	Ambient	Normal	10X1	1	0	0	512-HLC
9	10013522	ITOU 80g	7	Ambient	Normal	3X10	2	0	0	5A01-02-050
10	10044422	NABISCO 13PCSx3PK	8	Ambient	Normal	2X10	2	0	0	5A01-02-060
11	10555552	ITOU 90g	9	Ambient	Normal	12X1	5	0	0	5A01-02-060
12	10441002	EBARA 245ml	10	Ambient	Normal	12X1	4	0	0	5A01-02-060
13	10013522	URASHIMA8PCS	11	Ambient	Normal	2X15	0	1	0	5A01-03-030
14	10213002	NABISCO 44gx3PK	12	Ambient	Normal	2X10	2	0	0	5A02-05-030
15	10011002	NABISCO 9PCS	13	Ambient	Normal	4X10	2	0	0	5A02-05-040
16	10013522	AIMONO 70g	14	Ambient	Normal	2X20	1	0	0	5F02-01-011
17	30	1	0	54.60	0.684500	671	Total:
18
10048996

See my next reply for the macro code and instructions.

 

[hiker95]

miracleyy,

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub DistributeRowsV2()
' hiker95, 06/25/2014, ME785238
Dim w1 As Worksheet, ws As Worksheet, w As String
Dim Area As Range, r As Long, lr As Long, sr As Long, er As Long, nr As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")
With w1
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  For r = lr To 3 Step -1
    If .Cells(r, 1) = "Pick No:" Then .Rows(r).Insert
  Next r
End With
For Each Area In w1.Range("A1", w1.Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With Area
    sr = .Row
    er = sr + .Rows.Count - 1
    w = w1.Cells(sr, 4).Value
    If Not WorksheetExists(w) Then
      Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = w
    End If
    Set ws = Sheets(w)
    w1.Range("A" & sr & ":J" & er).Copy ws.Cells(1, 1)
    Application.CutCopyMode = False
    ws.Columns.AutoFit
  End With
Next Area
With w1
  On Error Resume Next
  .Range("A1", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
  .Activate
End With
Application.ScreenUpdating = True
End Sub
Function WorksheetExists(w As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(w).Name = w
On Error GoTo 0
End Function

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the DistributeRowsV2 macro.

 

[miracleyy]

Hiker,

Thank you very much! It works perfectly.

 

[hiker95]

miracleyy,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.