可視セルから結合セルへの貼り付けについて

質問

お世話になります。
ユーザーフォームに期間を入力し、オートフィルタから可視セル
をコピペしようと試みたのですが、貼り付け先が結合セルのため
うまく出来ません。可視セルをひとつずつ貼り付けるしかないのでしょうか？
仮にセルを一つずつ貼り付ける場合はどのようにコードを
書いたらよいでしょうか？
以下コード
Private Sub CommandButton1_Click()

Dim 開始日 As Date
Dim 終了日 As Date

条件 = Worksheets("sheet2").Range("C6")
場所 = Worksheets("sheet2").Range("A21")

開始日 = TextBox1
終了日 = TextBox2

If Worksheets("sheet1").AutoFilterMode Then
Worksheets("sheet1").AutoFilterMode = False
End If
ScreenUpdating = False
With Sheets("sheet1")
.Range("A5").AutoFilter Field:=2, Criteria1:=">=" & TextBox1, Operator:=xlAnd, _
Criteria2:="<=" & TextBox2 '条件日付
.Range("A5").AutoFilter Field:=13, Criteria1:="=" & 条件, Operator:=xlAnd '条件
End With
Range("A5").Select
Range("A5:X1000").Sort Key1:=Range("A5"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal

Worksheets("sheet1").Range("A5").CurrentRegion.SpecialCells (xlCellTypeVisible)
.Copy
Worksheets("sheet2").Range("A21").Offset(-1.1).PasteSpecial , Paste:=xlPasteValues
Range("C6").Select
Application.CutCopyMode = False
Worksheets("sheet1").AutoFilterMode = False
ScreenUpdating = True
End Sub

回答No.1

FEX2053 · ベストアンサー

単純にセル結合を解除してコピー、もう一度結合しなおし、
じゃダメなんですか？
多分そのほうが速度も速いんじゃないかと。

SpecialCells で引っ張ってきたセルを一つ一ついじるのは
結構面倒な処理なんで。

お礼

一度、別のセルに貼り付けて、値を貼り付けることにしました。
ありがとうございました。

補足

早速の回答ありがとうございます。
いろいろ探してみたのですが、SpecialCellsでコピペの際に
個別のセルを扱うなんてことは見つかりませんでした。

貼り付けるセルの個数は200～1500になります。
貼り付け先を変えるのが早いですね。
ちなみに、for～nextやdo～loopを使うのが面倒になるということで
しょうか？