フィルタでくくった状態でコピー貼り付け (2)

質問

以前に、http://okwave.jp/qa/q6456460.html　で質問して解決したのですが
別のパターンで質問です。

以前は、Ｌ２から絶対だったのですが、今回は、セルが決まってません。

Ｌの1404にセルを持ってくるのに
一応

Sub 仕入先ブランク解除()
Range("L1").Select
Selection.End(xlDown).Select
Selection.AutoFilter Field:=12, Criteria1:="=", Operator:=xlAnd
Call 下に移動
ActiveCell.FormulaR1C1 = "=RC[-9]"
Call 右に1マス移動
ActiveCell.FormulaR1C1 = "=RC[-9]"
End Sub

Sub 下に移動()
ro = ActiveCell.Row
co = ActiveCell.Column
Range(Cells(ro + 1, co), Cells(ro + 1, co)).Select
End Sub

Sub 右に移動()
ro = ActiveCell.Row
co = ActiveCell.Column
Range(Cells(ro + 1, co), Cells(ro + 1, co)).Select
End Sub

Sub 右に1マス移動()
i = ActiveCell.Row
j = ActiveCell.Column
Cells(i + 0, j + 1).Select
End Sub

Sub メーカー名コピーあんど貼付()
Dim r As Range
With ActiveSheet
Set r = .Range("L2", .Cells(.Rows.Count, "K").End(xlUp).Offset(, 1))
r.Item(1).Copy r
If .FilterMode Then
.ShowAllData
End If
r.Value = r.Value
End With
Set r = Nothing
End Sub

ってしました。
その後、関数のコピー貼り付けができません。（メーカー名コピーあんど貼付）の部分です
わかる方がいましたらお願いします。

回答No.1

end-u · ベストアンサー

全体を通して、
『データ範囲内のL列のうち、ブランクセルだけに数式を入れて、その数式を値化したい』
という処理ですか？

全部まとめて処理をすると

Sub test()
　　Dim r　As Range 'データ範囲のL列
　　Dim rr As Range 'L列ブランクセル

　　With ActiveSheet
　　　　'K列データ最終行を基準にL列範囲を変数にセット。
　　　　Set r = .Range("L2", .Cells(.Rows.Count, "K").End(xlUp).Offset(, 1))
　　　　'さらにL列ブランクセルをセット。
　　　　'この時ブランクセルが無ければエラーになるのでOn Error制御
　　　　On Error Resume Next
　　　　Set rr = r.SpecialCells(xlCellTypeBlanks)
　　　　On Error GoTo 0
　　　　'L列にブランクセルがある場合だけ処理する。
　　　　If Not rr Is Nothing Then
　　　　　　'L列ブランクセルに数式セット。
　　　　　　rr.FormulaR1C1 = "=RC[-9]"
　　　　　　'その右隣に数式セット。
　　　　　　rr.Offset(, 1).FormulaR1C1 = "=RC[-9]"
　　　　　　'L:M列まとめて数式を値化。
　　　　　　r.Resize(, 2).Value = r.Resize(, 2).Value
　　　　End If
　　End With
End Sub

こんな感じになります。
オートフィルタを使わず[ジャンプ]機能を使う例です。
>Set rr = r.SpecialCells(xlCellTypeBlanks)

基本、ActiveCellを移動させたりせず、Selectに依存しない書き方にしたほうが良いです。

どうしても Sub 仕入先ブランク解除 の後に続けたい場合は、
最後のActiveCellを基準にする事になります。

Sub メーカー名コピーあんど貼付2()
　　Dim r As Range

　　If ActiveCell.Column <> 13 Then Exit Sub
　　With ActiveSheet
　　　　Set r = ActiveCell
　　　　Set r = .Range(r, .Cells(.Rows.Count, "K").End(xlUp).Offset(, 1))
　　　　r.Item(1).Resize(, 2).Copy r
　　　　If .FilterMode Then
　　　　　　.ShowAllData
　　　　End If
　　　　r.Value = r.Value
　　End With
　　Set r = Nothing
End Sub