| 
    
     |  | こんにちは 
 シート名をどのようにするのか不明なのでそのままに
 A列の「データ1」を検索して処理しています。
 シートを挿入していますのでデータ数によってはErrが出る場合があります。
 「シート数はメモリ依存ですので」
 一応、お試しを(データシート=Sheet1としています)
 
 Sub test()
 Dim Fi As Range, Ro() As Long, Ad As String, Co As Long
 Dim Ws As Worksheet, i As Long
 Application.ScreenUpdating = False
 With Worksheets("Sheet1")
 .Range("A65536").End(xlUp).Offset(1).Value = "データ1"
 Set Fi = .Columns(1).Find("データ1", , xlValues, xlWhole, , xlPrevious)
 If Not Fi Is Nothing Then
 Ad = Fi.Address: Co = 0
 Do
 ReDim Preserve Ro(Co)
 Set Fi = .Columns(1).FindNext(Fi)
 Ro(Co) = Fi.Row
 Co = Co + 1
 Loop Until Ad = Fi.Address
 End If
 For i = 0 To UBound(Ro) - 1
 Set Ws = Worksheets.Add(After:=Sheets(Sheets.Count))
 .Range(.Cells(Ro(i), 1), .Cells(Ro(i + 1) - 1, 1)).EntireRow.Copy Ws.Range("A1")
 Set Ws = Nothing
 Next i
 .Range("A65536").End(xlUp).ClearContents
 End With
 Application.ScreenUpdating = True
 End Sub
 
 |  |