Help with copied data

[TheWennerWoman]

Book1.xlsm
	A	B	C	D	E	F
1	postno	code1	code2	vx	source	flag
2	1	C5678	103000	100	ZV0001
3	1	X00001	145444	28	ZV0001
4	1	X00001	173000	20	ZV0001
5	1	X00001	199000	19	ZV0001
6	1	X00001	212000	20	ZV0001
7	1	X00001	255666	13	ZV0001
8	2	C5678	103000	90	ZV0002
9	2	X00002	145444	17	ZV0002
10	2	X00002	173000	19	ZV0002
11	2	X00002	199000	27	ZV0002
12	2	X00002	212000	16	ZV0002
13	2	X00002	255666	11	ZV0002	end
14	3	C5678	103000	80	ZV0003
15	3	X00003	145444	15	ZV0003
16	3	X00003	173000	10	ZV0003
17	3	X00003	199000	32	ZV0003
18	3	X00003	212000	14	ZV0003
19	3	X00003	255666	9	ZV0003
20	4	C5678	103000	70	ZV0004
21	4	X00004	145444	13	ZV0004
22	4	X00004	173000	27	ZV0004
23	4	X00004	199000	10	ZV0004
24	4	X00004	212000	12	ZV0004
25	5	X00004	255666	8	ZV0004	end
26	5	C5678	103000	60	ZV0005
27	5	X00005	145444	11	ZV0005
28	5	X00005	173000	21	ZV0005
29	5	X00005	199000	10	ZV0005
30	5	X00005	212000	10	ZV0005
31	5	X00005	255666	8	ZV0005
Sheet2

I have the following bit of excellent code from @Peter_SSs which works perfectly on this

Sub New_Sheets_v2()
  Dim fr As Long, i As Long, lrD As Long
  Dim rend As Range
 
  Application.ScreenUpdating = False
  lrD = Range("A" & Rows.Count).End(xlUp).Row
  With Sheets("journal")
    fr = 2
    Set rend = .Columns("F").Find(What:="end")
    Do
      i = i + 1
      'Sheets.Add(After:=Sheets(Sheets.Count)).Name = "New " & i
      .Rows(fr & ":" & rend.Row).Copy Destination:=Worksheets("journal_" & i).Range("A1")
' I think I need to do something at this point
      If rend.Row = lrD Then Exit Do
      fr = rend.Row + 1
      Set rend = .Columns("F").Find(What:="end", After:=rend)
      If rend.Row < fr Then Set rend = Range("F" & lrD)
    Loop Until rend.Row < fr
  End With
  Application.ScreenUpdating = True
End Sub

My challenge now is column A. If postno is 1 consistent throughout column A file then do nothing. In my example, the first new bit of code has postno = 3. In that example, I need it reset to 1.

So in the above example, A14:A19 would be 1, A20:A24 would be 2, A25:A31 would be 1. So basically, reset column A after each "end" in column F.

This file is huge so I probably need to use an array.

Any pointers welcome.

 

[mumps]

The code you posted generates errors. The code below works properly to create the sheets and copy the data.

Sub New_Sheets_v2()
    Application.ScreenUpdating = False
    Dim rend As Range, sAddr As String, fr As Long, i As Long
    fr = 2
    Set rend = Sheets("journal").Range("F:F").Find("end", LookIn:=xlValues, LookAt:=xlWhole)
    If Not rend Is Nothing Then
        sAddr = rend.Address
        Do
            i = i + 1
            Sheets.Add(after:=Sheets(Sheets.Count)).Name = "journal_ " & i
            Sheets("journal").Rows(fr & ":" & rend.Row).Copy Range("A1")
            fr = rend.Row + 1
            Set rend = Sheets("journal").Range("F:F").Find("end", after:=rend, LookIn:=xlValues, LookAt:=xlWhole)
        Loop While rend.Address <> sAddr
        sAddr = ""
    End If
    Application.ScreenUpdating = True
End Sub

However, I don't follow what you are trying to do when you say :

My challenge now is column A. If postno is 1 throughout the file then do nothing. In my example, the first new bit of code has postno = 3. In that example, I need it reset to 1.
So in the above example, A14:A19 would be 1, A20:A24 would be 2, A25:A31 would be 1.

Please post a copy of the sheet with the expected result.