Excel2007で最下行のコピーについて

質問

Excel2007で最下行のコピーについてなんですが、上手くいきません。そこで質問させて頂きます。

sheet3のセルO6、セルP6、セルQ6から下に向かって5000行目までに格子と関数が既に入ってます。
が、しかしコピーをしたい数値は今のところはO、P、Qの6行目にとどまっています。なので最下行はセルOPQの6行目になります。

sheet3のセルOPQの最下行数値をsheet4のセルABCの2行目にコピぺしたいです。

そこで作ってみました。基軸と言いますかsheet1を選択してから標準モジュールに

Sub test()

Worksheets("sheet3").Select

Dim n As Long,t As Long

n = Cells(Rows.Count,"O").End(xlUp).Row ＋ 1

t = Cells(Rows.Count,"Q").End(xlUp).Row ＋ 1

Range("O" & n, "Q" & t).Value.Select

Selection =
Worksheets("sheet4").Range("A2:C2").Value
End Sub

と書きましたがエラーになります。どの様すればよろしいですか？お願い致します。

回答No.9

kkkkkm · ベストアンサー

これでいけると思います。

Sub Example() '条件付き書式の色を反映
Dim fcs As FormatConditions
Dim fc As FormatCondition
Dim myCell As Range
Dim i As Integer

With Sheets("Sheet3")
With .Range("O:O")
Set myCell = .Find(What:="*", After:=.Cells(.Rows.Count), LookIn:=xlValues, SearchDirection:=xlPrevious)
End With
If myCell Is Nothing Then
MsgBox "O列にデータがありません"
Exit Sub
End If
Worksheets("sheet4").Range("A2:C2").Value = .Range(.Cells(myCell.Row, "O"), .Cells(myCell.Row, "Q")).Value
For i = 0 To 2
If .Cells(myCell.Row, Range("O:O").Column + i).Value = .Cells(myCell.Row + 1, "N") And .Cells(myCell.Row + 1, "N") <> "" Then
Set fcs = .Cells(myCell.Row, Range("O:O").Column + i).FormatConditions
Set fc = fcs(1)
Worksheets("sheet4").Cells(2, Range("A:A").Column + i).Interior.Color = fc.Interior.Color
Else
Worksheets("sheet4").Cells(2, Range("A:A").Column + i).Interior.Pattern = xlNone
End If
Next i
End With
End Sub

お礼

バッチしとできましたっ！！！(^_^)
ちょっとのことなのにこんなにソースが長いなんて影の努力があるんですね。
ここまでしていただいてありがとうございました。

本当に助かりました。また見かけたらよろしくお願いします。ありがとうございました。

補足

すみません。今の作業に多少なりご理解して頂いてるkkkkkmさんにここで、質問させて下さい。

Excel2007でカウントしたいですがご協力お願い致します。

今ところはセルU6～U4363にデータが入ってますが、それ以上にデータは増えていきます。

幾つか背景カラー(ミドリ)が入ってるセルがありまして、U列の6行目から下のカラーセルの合計個数をセルU4に表したいです。
条件付き書式もあの形なんです。
お願い致します。

回答No.10

kkkkkm

> Excel2007でカウントしたいですがご協力お願い致します。

別の問題なので別に質問をしてください。
このユーザーに質問するを押すと新規質問になり多分私に通知が来ると思います。他の方も閲覧できるので状況は詳しく書かないと「意味不明」という回答が他の方から寄せられる可能性がありますし、他の方が無駄に考えずに済みます。
私より優れた方の回答がある可能性も大いにあります。

> 幾つか背景カラー(ミドリ)が入ってるセルがありまして

単にミドリではわかりません。書式設定をみたら分かると思いますがいろいろな緑があります。単に色がついているかどうかならそれで判別できます。

> U列の6行目から下のカラーセルの合計個数をセルU4に表したいです。

数式だけのセルに色がついていないとすればEnd(xlUp).Row で数式の入ったセルまで含めて計算の範囲に含めても問題ないと思いますが、数式があればその旨も記載したほうがいでしょう。

> 条件付き書式もあの形なんです。

「適用先はO6:Q4363でした。」適用先にU列は入っていませんが…。
どちらにしても、新しい質問にその数式と適用先を記載しておいてください。

お礼

ありがとうございました。

回答No.8

kkkkkm

> 「形式を選択して貼り付け」のダイアログボックスにある「すべて(A)」をソース上に表した場合の何かを付けたして解決する方法

全て貼り付けて(関数だと値が表示されないことがある)その後値を貼り付けるという感じでしょうか。
.Range("A2:C2").PasteSpecial Paste:=xlPasteAll
.Range("A2:C2").PasteSpecial Paste:=xlPasteValues

「色や罫線も含めて」のコードと結果は同じような気もしますが試してみてください。

「形式を選択して貼り付け」のいろいろな指定方法がこちらにあります。
https://excel-ubara.com/excelvba1/EXCELVBA341.html

また、セルの値によって自動で色が変わるようでしたら条件付き書式を設定していると思いますので、そのあたりも確認してみてください。セルを選択して[ホーム]タブの[スタイル]グループで[条件付き書式]で見れます。

エクセル2010以降だと条件付き書式で付けた色も「セルごとに色が違う」パターンを少し変えるだけでいけるのですがないものねだりをしても…ですね。

お礼

＞条件付き書式の設定が色を付けるセル以外のセルの値(O列のセルの色付けをN列のセルの値など)で決定していると思います。
その場合は、以下の方法が考えられます。
A)　条件付き書式の数式を作り直してSheet4のA2:C2に設定する
元の値の変化により色が変わる(元の値が無くなると色が無くなる)
条件付き書式の条件がわからないとコードが書けない。

B)　条件付き書式で設定されている色を単にセルに付ける。
コピー時点でついていた色のまま変わらない。
そのセルについた条件付き書式の何番目かがわからないとコードが書けない。

と解答頂いたんですが、一度、私にとっては説明が難しい… 、 と諦めたんですが理解ができ説明が出来そうなんで説明させてください。

sheet3のセルOPQにカーソルあわせて条件付き書式ルールの管理をみたら数式を作ってまして内容は、
=And(O6=$N7,$N7＜＞"")
で
適用先は
O6:Q4363でした。
その場合はどの様にすればよろしいですか。

回答No.7

kkkkkm

> セルごとに色が違うを選んでしましたが、失敗してしまいます。

失敗というのが違う色になるもしくは色がつかないということでしたら
こちらに変更してみてください。
.Range("A2").Interior.Color = Sheets("Sheet3").Cells(myCell.Row, "O").Interior.Color
.Range("B2").Interior.Color = Sheets("Sheet3").Cells(myCell.Row, "P").Interior.Color
.Range("C2").Interior.Color = Sheets("Sheet3").Cells(myCell.Row, "Q").Interior.Color

上記で駄目な場合
条件付き書式で色を付けている場合には
色や罫線も含めてセルの書式設定をコピーする場合
を実行してください。
これでも付かない場合には、条件付き書式の設定が色を付けるセル以外のセルの値(O列のセルの色付けをN列のセルの値など)で決定していると思います。
その場合は、以下の方法が考えられます。
A)　条件付き書式の数式を作り直してSheet4のA2:C2に設定する
元の値の変化により色が変わる(元の値が無くなると色が無くなる)
条件付き書式の条件がわからないとコードが書けない。

B)　条件付き書式で設定されている色を単にセルに付ける。
コピー時点でついていた色のまま変わらない。
そのセルについた条件付き書式の何番目かがわからないとコードが書けない。

お礼

大変丁寧なご解答をしていただき誠にありがとうございます。
しかし私にはこれ以上は説明が難しくてできそうにありません。
まだまだ駆け出しみたいなもので説明のしようがありません(^_^ゞ
質問しておきながら誠に恐縮なんですがこの場を借りて継続して質問させてください。
Interior.Colorのように特定する方法があるみたいに、「形式を選択して貼り付け」のダイアログボックスにある「すべて(A)」をソース上に表した場合の何かを付けたして解決する方法はございませんでしょうか。
何かあればなーと思い立ちました。ありますでしょうか(^_^ゞ

回答No.6

kkkkkm

> コピーするセル背景にカラーが入っててそれも一緒にコピーしたい

Worksheets("sheet4").Range("A2:C2").Value = .Range(.Cells(myCell.Row, "O"), .Cells(myCell.Row, "Q")).Value
を削除して

以下のように変更してください

色や罫線も含めてセルの書式設定をコピーする場合
.Range(.Cells(myCell.Row, "O"), .Cells(myCell.Row, "Q")).Copy
With Worksheets("sheet4").Range("A2:C2")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
Application.CutCopyMode = False

データとセルの背景色だけの場合(すべて同じ色)
.Range(.Cells(myCell.Row, "O"), .Cells(myCell.Row, "Q")).Copy
With Worksheets("sheet4").Range("A2:C2")
.PasteSpecial Paste:=xlPasteValues
.Interior.ColorIndex = Sheets("Sheet3").Cells(myCell.Row, "O").Interior.ColorIndex
End With
Application.CutCopyMode = False

データとセルの背景色だけの場合(セルごとに色が違う)
.Range(.Cells(myCell.Row, "O"), .Cells(myCell.Row, "Q")).Copy
With Worksheets("sheet4")
.Range("A2:C2").PasteSpecial Paste:=xlPasteValues
.Range("A2").Interior.ColorIndex = Sheets("Sheet3").Cells(myCell.Row, "O").Interior.ColorIndex
.Range("B2").Interior.ColorIndex = Sheets("Sheet3").Cells(myCell.Row, "P").Interior.ColorIndex
.Range("C2").Interior.ColorIndex = Sheets("Sheet3").Cells(myCell.Row, "Q").Interior.ColorIndex
End With
Application.CutCopyMode = False

お礼

すみません。こんなにたくさん作って頂いたのですが、コピーは上手くいきますが背景カラーだけが上手くいきません。他に原因とかありそうですか？

補足

セルOPQのいずれかが黄色の背景の場合があるんです。ので最後の、セルごとに色が違うを選んでしましたが、失敗してしまいます。

回答No.5

kkkkkm

No4の訂正です
No4(No3も)だとSheet3以外を開いて実行したときに違うところがコピーされるのでこちらに変更してください。

Sub Example()
Dim myCell As Range

With Sheets("Sheet3")
With .Range("O:O")
Set myCell = .Find(What:="*", After:=.Cells(.Rows.Count), LookIn:=xlValues, SearchDirection:=xlPrevious)
End With
If myCell Is Nothing Then
MsgBox "O列にデータがありません"
Exit Sub
End If
Worksheets("sheet4").Range("A2:C2").Value = .Range(.Cells(myCell.Row, "O"), .Cells(myCell.Row, "Q")).Value
End With
Set myCell = Nothing
End Sub

お礼

凄く上手くいきました。コピーするセル背景にカラーが入っててそれも一緒にコピーしたいのですがどの様にすればよろしいでしょうか？

補足

そのセルにある背景カラーもそのままコピーするには何をどの様に付けたしが必要ですか？

回答No.4

kkkkkm

> セルOPQは常に空白無しで水平になります

でしたらO列の最終行だけ探せばいいですね。以下のような感じでいかがですか。

Sub Example()
Dim myCell As Range

With Sheets("Sheet3").Range("O:O")
Set myCell = .Find(What:="*", After:=.Cells(.Rows.Count), LookIn:=xlValues, SearchDirection:=xlPrevious)
End With
If myCell Is Nothing Then
MsgBox "O列にデータがありません"
Exit Sub
End If
Worksheets("sheet4").Range("A2:C2").Value = Range(Cells(myCell.Row, "O"), Cells(myCell.Row, "Q")).Value
Set myCell = Nothing
End Sub

お礼

ありがとうございました。

回答No.3

kkkkkm

> sheet3のセルOPQの最下行数値をsheet4のセルABCの2行目にコピぺしたいです。

でしたか。
だとしたら

Range("O" & n, "Q" & t).Select
Selection = Worksheets("sheet4").Range("A2:C2").Value

だと逆にOPQにA2,C2,B2をコピーすることになります。

VBAでは=の右側を左側に代入(コピー)します。

No2で紹介したQ&Aのコードを利用してOとQの最終行の行番号の大きいほうのデータをA2:C2にコピーする参考です。

Sub Example()
Dim myCello As Range, myCellq As Range

With Sheets("Sheet3").Range("O:O")
Set myCello = .Find(What:="*", After:=.Cells(.Rows.Count), LookIn:=xlValues, SearchDirection:=xlPrevious)
End With
If myCello Is Nothing Then
MsgBox "O列にデータがありません"
Exit Sub
End If
With Sheets("Sheet3").Range("Q:Q")
Set myCellq = .Find(What:="*", After:=.Cells(.Rows.Count), LookIn:=xlValues, SearchDirection:=xlPrevious)
End With
If myCellq Is Nothing Then
MsgBox "Q列にデータがありません"
Exit Sub
End If
If myCello.Row >= myCellq.Row Then
Worksheets("sheet4").Range("A2:C2").Value = Range(Cells(myCello.Row, "O"), Cells(myCello.Row, "Q")).Value
Else
Worksheets("sheet4").Range("A2:C2").Value = Range(Cells(myCellq.Row, "O"), Cells(myCellq.Row, "Q")).Value
End If
Set myCello = Nothing
Set myCellq = Nothing
End Sub

お礼

ありがとうございました。

回答No.2

kkkkkm

Range("O" & n, "Q" & t).Value.Select
は
Range("O" & n, "Q" & t).Select
だとして
End(xlUp).Row は数式があるとその行まで認識してしまいます。
解決策がこちらにありますので参考にしてください。

ExcelVBAで数式の空白を返さないようにするに
https://okwave.jp/qa/q8710657.html

ちなみに、今のコードだとOとQの最終行が段違いの場合A2:C2がその段違い分コピーされOかQのどちらか下にある行が上書きされますが、それは想定内でしょうか。

お礼

ご返答ありがとうございます。セルOPQは常に空白無しで水平になります。参考を見させて頂きましたが今の私では理解度がまだまだ達してませんでした。

回答No.1

unokwave

>Range("O" & n, "Q" & t).Value.Select

.Valueか.Selectのどちらかでしょう。
.select後にSelection.Valueを実行することは可能ですが。

お礼

やってみたのですが何故か、格子と関数が入っただけの5000行目の次にいってしまいます。関数せいなんでしょうか？返答ありがとうございました。