リストから重複行を削除して貼り付けるとき．．．

質問

Range("D6:D37").AdvancedFilter Action:=xlFilterCopy, _
copytorange:=Sheets("集計").Range("c2"), unique:=True
　以上のようなマクロを実行させたとき，Ｄ６～Ｄ３７のセルの中に
　空白行もあり，リストをシート「集計」のＣ２のセルに貼り付けた
　結果をみてみると，空白も貼り付けられています。
　この空白を除いて貼り付ける方法をご教授していただけたらと思います。

回答No.2

merlionXX · ベストアンサー

No1です。
こちらに差し替えてください。

Sub TEST01()
Dim Rng As Range
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set Rng = Range("D6:D37")
ActiveSheet.AutoFilterMode = False
With Rng
.AutoFilter
.AutoFilter Field:=1, Criteria1:="<>"
.SpecialCells(xlCellTypeVisible).Copy
End With
ActiveSheet.AutoFilterMode = False
With Sheets("集計")
.Range("IV2").PasteSpecial
Application.CutCopyMode = False
.Range("IV2", .Range("IV2").End(xlDown)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=.Range("C2"), Unique:=True
.Range("IV2", .Range("IV2").End(xlDown)).ClearContents
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
Set Rng = Nothing
End Sub

回答No.3

CHRONOS_0

ジャンプのセル選択を使えば値のあるセルだけを選択できますね

Sub Macro()

Range("D6:D37").Select
Selection.SpecialCells(xlCellTypeConstants, 23).Select
Selection.Copy
Sheets("集計").Select
Range("C2").Select
ActiveSheet.Paste
End Sub

回答No.1

merlionXX

リストのRange("D6:D37")と、貼り付け先のSheets("集計")は別のシートなんですね？

Sub TEST()

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Set Rng = Range("D6:D37")
ActiveSheet.AutoFilterMode = False
With Rng
.AutoFilter
.AutoFilter Field:=1, Criteria1:="<>"
.SpecialCells(xlCellTypeVisible).Copy
End With
ActiveSheet.AutoFilterMode = False
With Sheets("集計")
.Range("IV2").PasteSpecial
Application.CutCopyMode = False
.Range("IV2", .Range("IV2").End(xlDown)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=.Range("C2"), Unique:=True
.Range("IV2", .Range("IV2").End(xlDown)).ClearContents
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

これでどうでしょうか？