Copy data in between 2 cells

[ceclay]

Hi,
Would like to ask help. I have this 1 column data below:

Golf Data.xlsx
	A
1	Performance Win Only
2	Mickelson, Jake
3	23
4	n
5	Si Woo Jun
6	23
7	n
8	Steele, Brick
9	23
10	n
11	Dahmen, Nina
12	29
13	n
14	Garcia, Srick
15	29
16	n
17	Spieth, Michael
18	31
19	n
20	Varner , Franco
21	31
22	n
23	Lowry, Nica
24	34
25	n
26	Grillo, Emiliano
27	Opens:
28	200908 1211
29	Suspends:
30	200910 1600
31	Closes:
32	Straight Forecast
33	1. Garcia, Sergio/2. Mickelson, Phil
34	541
35	n
36	1. Mickelson, Phil/2. Garcia, Sergio
37	541
38	n
39	1. Mickelson, Phil/2. Steele, Brendan
40	541
41	n
42	1. Steele, Brendan/2. Mickelson, Phil
43	541
44	n
45	1. Lowry, Shane/2. Mickelson, Phil
46	601
47	n
48	Opens:
49	200908 1211
50	Suspends:
51	200910 1600
52	Closes:
Sheet4

I would like to copy data in between "Performance Win Only" and "Opens:" to make it like below:

Golf Data.xlsx
	F	G	H	I	J
1
2	Mickelson, Jake		Mickelson, Jake	23	n
3	23		Si Woo Jun	23	n
4	n		Steele, Brick	23	n
5	Si Woo Jun		Dahmen, Nina	29	n
6	23		Garcia, Srick	29	n
7	n		Spieth, Michael	31	n
8	Steele, Brick		Varner , Franco	31	n
9	23		Lowry, Nica	34	n
10	n
11	Dahmen, Nina
12	29
13	n
14	Garcia, Srick
15	29
16	n
17	Spieth, Michael
18	31
19	n
20	Varner , Franco
21	31
22	n
23	Lowry, Nica
24	34
25	n
Sheet4

Also, copy data in between "Straight Forecast" and "Opens" to make it like below:

Golf Data.xlsx
	L	M	N	O
1
2	1. Garcia, Sergio/2. Mickelson, Phil	1. Garcia, Sergio/2. Mickelson, Phil	541	n
3	541	1. Mickelson, Phil/2. Garcia, Sergio	541	n
4	n	1. Mickelson, Phil/2. Steele, Brendan	541	n
5	1. Mickelson, Phil/2. Garcia, Sergio	1. Steele, Brendan/2. Mickelson, Phil	541	n
6	541	1. Lowry, Shane/2. Mickelson, Phil	601	n
7	n
8	1. Mickelson, Phil/2. Steele, Brendan
9	541
10	n
11	1. Steele, Brendan/2. Mickelson, Phil
12	541
13	n
14	1. Lowry, Shane/2. Mickelson, Phil
15	601
16	n
Sheet4

 

[Fluff]

How about

Sub ceclay()
   Dim Ary(1 To 2) As Variant, Nary As Variant
   Dim Ar As Areas
   Dim r As Long, i As Long, nr As Long
   
   With Range("A:A")
      .Replace "Opens:", "=A1", xlWhole, , False, , False, False
      .Replace "Closes:", "=xxx", xlWhole, , False, , False, False
      Set Ar = .SpecialCells(xlConstants).Areas
      .Replace "=A1", "Opens:", xlWhole, , False, , False, False
      .Replace "=xxx", "Closes:", xlWhole, , False, , False, False
   End With
   Ary(1) = Ar(1).Value2
   Ary(2) = Ar(3).Value2
   Range("F1").Resize(UBound(Ary(1))).Value = Ary(1)
   Range("L1").Resize(UBound(Ary(2))).Value = Ary(2)
   For i = 1 To 2
      ReDim Nary(1 To UBound(Ary(i)), 1 To 3)
      For r = 2 To UBound(Ary(i)) - 1 Step 3
         nr = nr + 1
         Nary(nr, 1) = Ary(i)(r, 1)
         Nary(nr, 2) = Ary(i)(r + 1, 1)
         Nary(nr, 3) = Ary(i)(r + 2, 1)
      Next r
      If i = 1 Then
         Range("H2").Resize(nr, 3).Value = Nary
      Else
         Range("M2").Resize(nr, 3).Value = Nary
      End If
      nr = 0
   Next i
End Sub

 

[Peter_SSs]

Another approach:

Sub Extract_Data()
  Dim rStart As Range, rEnd As Range
  Dim r As Long
  
  Set rStart = Columns("A").Find(What:="Performance Win Only", LookAt:=xlWhole, MatchCase:=False)
  If Not rStart Is Nothing Then
    Set rEnd = Columns("A").Find(What:="Opens:", After:=rStart, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
    If Not rEnd Is Nothing Then
      r = rStart.Row + 1
      Do While r + 2 < rEnd.Row
        Range("H" & Rows.Count).End(xlUp).Offset(1).Resize(, 3).Value = Application.Transpose(Range("A" & r).Resize(3).Value)
        r = r + 3
      Loop
    End If
  End If
  
  Set rStart = Columns("A").Find(What:="Straight Forecast", LookAt:=xlWhole, MatchCase:=False)
  If Not rStart Is Nothing Then
    Set rEnd = Columns("A").Find(What:="Opens:", After:=rStart, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
    If Not rEnd Is Nothing Then
      r = rStart.Row + 1
      Do While r + 2 < rEnd.Row
        Range("M" & Rows.Count).End(xlUp).Offset(1).Resize(, 3).Value = Application.Transpose(Range("A" & r).Resize(3).Value)
        r = r + 3
      Loop
    End If
  End If
End Sub

 

[ceclay]

Thank you very much Peter_SSs and @Fluff

 

[Peter_SSs]

You're welcome. Glad we could help. Thanks for the follow-up.