|
▼ひらた さん:
こんばんは
いろんな方法がありますが、行数が膨大でなければ以下のようなコードでも。
Sub Sample()
Dim v() As String
Dim i As Long, z As Long
Application.ScreenUpdating = False
With Worksheets("Sheet1") '<== 実際のシート名に
z = .Range("A" & .Rows.Count).End(xlUp).Row
ReDim v(2 To z)
For i = 2 To z
v(i) = i & ":" & i
Next
.Range(Join(v, ",")).Insert shift:=xlDown
z = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 1 To z Step 2
.Range("B" & i + 1).Value = .Range("C" & i).Value
.Range("C" & i).ClearContents
.Range("A" & i).Resize(2).MergeCells = True
Next
End With
Application.ScreenUpdating = True
End Sub
|
|