| |
こんにちは
シート名をどのようにするのか不明なのでそのままに
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
|
|
Statis
- 05/12/12(月) 12:00 -
