エクセルのマクロについてお願いいたします。

質問

エクセルのマクロについてお願いいたします。
E１０～M１０の５００行全てのセルに数式が入っております。
そこでマクロにてコピーのボタンを設置しようと思ってます。
Range("E10:M10" & Range("M" & Rows.Count).End(xlUp).Row).Copy

画像のような数字の結果がある部分だけコピーをしたいです。
２３行目からは数式が入ってますが結果は””空白になっております。

どうぞよろしくお願いいたします。

回答No.1

mitarashi · ベストアンサー

オートフィルターが使える状況なら、
E10:M509？を選択して、オートフィルタ、「空白以外」でフィルタをかけてコピー
を自動記録すれば良いでしょう。
別の解としては、E10からRange("E" & i)<>""の間、ループを回して最後の値が入ったセルを見つければ良いと思いますが、最近参考書を読み返していて、再発見したコードをアレンジして回答します。セルのコピー部分は一例です。
なお、xlValuesのところをxlFormulasにすると、式の入ったセルも対象にします。
Sub test()
Dim lastCell As Range, srcRange As Range

With Columns("$E:$E")
Set lastCell = .Find("*", .Cells(1), xlValues, xlWhole, xlByColumns, xlPrevious)
End With
If lastCell Is Nothing Then
MsgBox "対象範囲にデータがありません"
Exit Sub
End If
Set srcRange = Range(Range("$E$10"), lastCell).Resize(, 9)
srcRange.Copy
Sheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues
End Sub

お礼

すばやくとても勉強になりました。ほんとうにありがとうございます。

回答No.4

kmetu

ActiveSheet.UsedRange.Find("*", , xlValues, , xlByRows, xlPrevious).Row

でM列の空白でない最終行が取得できます

が、画像のデータしかないものと考えていますので、他にM22行より右下にデータがあればその行数が取得されてしまいます。

回答No.3

tom04

こんばんは！
最終行を取得する場合、空白セルでも数式が入っていると空白セルと判断しませんので、

一つの案です。
数式が入ってる空白セルの数式を削除すれば、最終行の取得はできると思います。
それをコピー＆ペーストしてみてはどうでしょうか？

コードの一例です。

Sub test()
Dim i, j, k As Long
For i = Cells(Rows.Count, 5).End(xlUp).Row To 10 Step -1
For j = 6 To 13
If Cells(i, j).HasFormula = True And Cells(i, j) = "" Then
Cells(i, j).Clear
End If
Next j
Next i
k = Cells(Rows.Count, 13).End(xlUp).Row
Range(Cells(10, 5), Cells(k, 13)).Copy Cells(1, 14) '←N1セル以降に貼り付けしています
End Sub

とりあえずデータを別Sheetにコピー＆ペーストしてマクロを試してみてください。

以上、この程度ですが
参考にならなかったらごめんなさいね。m(__)m

回答No.2

end-u

[Ctrl]+[g]のジャンプ機能を元に、数式かつ数値結果のセル範囲を取得できます。
該当セルが無いとエラーになりますからエラー対策も必要です。

Sub try()
　　Dim r As Range

　　On Error GoTo errHandler
　　Set r = Columns("E:M").SpecialCells(xlCellTypeFormulas, xlNumbers)
　　'分断されているエリアの最終エリアをセットし直し
　　Set r = r.Areas(r.Areas.Count)
　　Range("E10", r).Resize(, 9).Copy
　　'：
　　'ここでPaste処理？
　　'：
errHandler:
　　If Err.Number <> 0 Then
　　　　MsgBox Err.Number & "::" & Err.Description
　　End If
　　Set r = Nothing
End Sub

あるいはM列で判定可能な場合は
ワークシートのMATCH関数を使っても良いかもしれません。
Dim x As Variant
x = Application.Match(1E+15, Columns("M"))
If IsNumeric(x) Then
　　Range("E10:M" & x).Copy
End If

お礼

とても勉強になりました。有難う御座いました。また、機会がありましたらよろしくお願いいたします。