可視セルから結合セルへの貼り付けについて
お世話になります。
ユーザーフォームに期間を入力し、オートフィルタから可視セル
をコピペしようと試みたのですが、貼り付け先が結合セルのため
うまく出来ません。可視セルをひとつずつ貼り付けるしかないのでしょうか？
仮にセルを一つずつ貼り付ける場合はどのようにコードを
書いたらよいでしょうか？
以下コード
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
お礼
お返事遅くなってすみませんでした。 やってみたら、バッチリできました！！ ありがとうございましたー！！