|
では、こんな感じで。
Sub MyYear_Data()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim MyR As Range, MyR2 As Range, C As Range
Dim Rw As Long
Set Sh1 = Worksheets("Sheet1"): Set Sh2 = Worksheets("work")
Application.ScreenUpdating = False
With Sh1.Range("A2", Sh1.Range("A65536").End(xlUp)).Offset(, 1)
.Formula = "=IF($A2<>$A3,COUNTIF($A$2:$A2,$A2))"
.Value = .Value
Set MyR = .SpecialCells(2, 1)
End With
For Each C In MyR
Rw = C.Value
Set MyR2 = C.Offset(-1 * (Rw - 1)).Resize(Rw).EntireRow
MyR2.Copy Sh2.Range("A2")
Sh2.Range("B:B").ClearContents
'ここへ変数 Sh2 を使って、コピーしたデータの加工をするコードを書く
MyR2.ClearContents: Set MyR2 = Nothing
Next
Sh2.Activate
Set MyR = Nothing: Set Sh1 = Nothing: Set Sh2 = Nothing
Application.ScreenUpdating = True
End Sub
|
|