| |
A列の各年度毎に新規シートを挿入し、それぞれの年度のデータをA1からコピーする。
ということがしたいのでしょーか ? いちおうそれを前提に組んでみました。
Sub Mk_NewSheets()
Dim Cnt As Long, i As Long, Rw As Long
Dim MyR As Range, C As Range
Dim Ttl As Variant, Ary As Variant
Application.ScreenUpdating = False
Sheets("Sheet1").Activate: Ttl = Rows(1).Value
With Range("A2", Range("A65536").End(xlUp)).Offset(, 1)
.Formula = "=IF($A2<>$A3,$A2&"",""&COUNTIF($A$2:$A2,$A2))"
.Value = .Value
Set MyR = .SpecialCells(2, 2)
End With
Cnt = Worksheets.Count
Worksheets.Add After:=Worksheets(Cnt), Count:=MyR.Count
For Each C In MyR
i = i + 1: Ary = Split(C.Value, ","): Rw = CLng(Ary(1))
With Worksheets(Cnt + i)
.Name = CStr(Ary(0))
.Rows(1).Value = Ttl
C.Offset(-1 * (Rw - 1)).Resize(Rw).EntireRow _
.Copy .Range("A2")
.Range("B:B").ClearContents
End With
Erase Ary
Next
MyR.EntireColumn.ClearContents: Set MyR = Nothing
Application.ScreenUpdating = True
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 07/1/14(日) 20:37 -
