[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『貼り付け後、数式箇所が0で貼りつく』（けい）
Sheet1のデータをSheet2に貼り付ける際、
Sheet1の数式のみで値のない箇所はSheet2に”0”となって貼りついてしまいます。
値の表示されているセルのみを貼り付けるにはどうすればいいのでしょうか？
よろしくお願いいたします。
Sub Macro6()
Columns("A:A").Select
Selection.ClearContents
Sheets("Sheet1").Select
Range("A2:A151").Select
Selection.Copy
Sheets("Sheet2").Select
Cells(Rows.Count, 1).End(xlUp).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Range("B2:B151").Select
Selection.Copy
Sheets("Sheet2").Select
Cells(Rows.Count, 1).End(xlUp).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Range("C2:C151").Select
Selection.Copy
Sheets("Sheet2").Select
Cells(Rows.Count, 1).End(xlUp).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
Sheet1でオプションか表示形式か条件付き書式で0を非表示または白色表示にしていないだろうか？ （ねむねむ） 2021/05/26(水) 13:05
マクロの事はわかりませんがSkipBlanksがFalseになっているのでTrueにすればよいのでは （なるへそ） 2021/05/26(水) 13:07
Sheet1の列にはINDIRECT関数の結果が表示されており、
表示のない部分がSheet2では 0 で貼り付けられています。
Sheet2の表示形式は「標準」になっています。
ねむねむ様
ありがとうございます。
表示形式で白色表示にしています。
何か関係があるのでしょうか？
なるへそ様
Trueに変えてみましたが、特に変化はありませんでした。
（けい） 2021/05/26(水) 13:35
表示形式はあくまでも見た目を変えているだけでセルの値そのものは変わっていない。 なので0を白色表示していてもセルの値そのものは0のままなので張り付ければその0が張り付けられることになる。 （ねむねむ） 2021/05/26(水) 13:37
例えば、Sheet1の列 150行にINDIRECT関数が入っていて、
実際にデータが返っている行は100行とします。
Sheet1をコピーしてSheet2に貼り付けた後、
101行目以降が”0”で貼りつくのですが、やりたいことは
データのある100行目までだけを貼り付けたいのです。
（けい） 2021/05/26(水) 13:44
INDIRECT関数の式を =IF(INDIRECT(〜)&""="","",INDIRECT(〜)) としてはどうだろうか？ これでINDIRECT関数の参照先が空白ならば空白が返るようになる。 もし、INDIRECT関数で返るのが文字列だけであれば =INDIRECT(〜)&"" でもいいが。 （ねむねむ） 2021/05/26(水) 13:48
試してみます。
（けい） 2021/05/26(水) 14:16
また、説明がたりませんでした。
確かに０は貼り付けられなくなりましたが、
最下行は150行目を取得してしまいます。
続いて、B列をコピーして貼り付ける際に、
151行目から貼付を開始してしまいます。
（けい） 2021/05/26(水) 14:46
貼り付け(PasteSpecial)後、
Worksheets("Sheet2").UsedRange.Formula = Worksheets("Sheet2").UsedRange.Formula
を入れてみてはどうだろうか？
（ねむねむ） 2021/05/26(水) 15:28
すごい・・
思った通りの結果がでました。
ありがとうございました。
（けい） 2021/05/26(水) 15:41
個人的にSelect使わないとどうなるかとかやっていて気付いたのだがこれだとB列の値の一番最初が A列の一番最後を上書きしてしまわないだろうか？ で、上記の対応とSelectを使わない形に書き換えてみた。 （ねむねむ） 2021/05/26(水) 15:51
Sub Macro6()
Dim WK_RANGE As Range
Worksheets("Sheet2").Columns("A:A").ClearContents
Worksheets("Sheet1").Range("A2:A151").Copy
Set WK_RANGE = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)
If WK_RANGE.Value <> "" Then Set WK_RANGE = WK_RANGE.Offset(1, 0)
WK_RANGE.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").UsedRange.Formula = Worksheets("Sheet2").UsedRange.Formula
（ねむねむ） 2021/05/26(水) 15:53
Worksheets("Sheet1").Range("B2:B151").Copy
Set WK_RANGE = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)
If WK_RANGE.Value <> "" Then Set WK_RANGE = WK_RANGE.Offset(1, 0)
WK_RANGE.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").UsedRange.Formula = Worksheets("Sheet2").UsedRange.Formula
（ねむねむ） 2021/05/26(水) 15:53
Worksheets("Sheet1").Range("C2:C151").Copy
Set WK_RANGE = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)
If WK_RANGE.Value <> "" Then Set WK_RANGE = WK_RANGE.Offset(1, 0)
WK_RANGE.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").UsedRange.Formula = Worksheets("Sheet2").UsedRange.Formula
End Sub
（ねむねむ） 2021/05/26(水) 15:53
書込み環境のせいで長いものを書き込めないためぶつ切りになってしまってすまない。 これで試してみてくれ。 （ねむねむ） 2021/05/26(水) 15:56
新しいコードの記述も感謝します。
試してみましたが、うまくいきました。
思い通りの結果です。
この期に及んですみません
このA列からC列のコピー＆ペーストをAJ列まで繰り返すので
様々なサイトから繰り返しのコードを探しているところです。
中々しっくりいくのが見つからないのですが、もう少し探してみます。
（けい） 2021/05/26(水) 16:10
こういうことだろうか？
相変わらずブツ切れですまない。
Sub Macro6()
Dim WK_RANGE As Range
Dim COL_CNT As Integer
Worksheets("Sheet2").Columns("A:A").ClearContents
Application.ScreenUpdating = False
For COL_CNT = 1 To 36 'A列が1列目、AJ列が36列目
With Worksheets("Sheet1")
.Range(.Cells(2, COL_CNT), .Cells(151, COL_CNT)).Copy
End With
（ねむねむ） 2021/05/26(水) 16:41
Set WK_RANGE = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)
If WK_RANGE.Value <> "" Then Set WK_RANGE = WK_RANGE.Offset(1, 0)
WK_RANGE.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Sheet2").UsedRange.Formula = Worksheets("Sheet2").UsedRange.Formula
Next
Application.ScreenUpdating = True
End Sub
（ねむねむ） 2021/05/26(水) 16:42
感動で震えそうです。
やりたいことはこれです。
もっと勉強します！
ありがとうございました。
（けい） 2021/05/26(水) 16:52
解決済みなので、余談ということになりますが、閲覧者の参考になれば幸いです。
(1)当初は、コピー元には、
該当なしの場合、0が返るような関数式としていた。
（ただし、書式で、0 を 非表示になるよう調整）
(2)その後、指摘に基づき、修正して、
該当なしの場合、""が返る関数式に変更した、 ということですね。
"" だけの行も併せて、いったんコピーペイストしたうえで、
.Formula = .Formula
とすることで、""を消去した、ということですね。
| Sheet1をコピーしてSheet2に貼り付けた後、 | 101行目以降が”0”で貼りつくのですが、やりたいことは | データのある100行目までだけを貼り付けたいのです。 ということなので、これをそのまま実行することも可能です。
(1) ""ではない「実質的に値の入っている最終行」を求め、 (2) 2行目からそこまでを対象に、コピーペイストする とすればよいでしょう。
コードは、以下のとおりです。なにかの参考になれば。
Sub test()
Dim rng As Range
Dim c As Long
Dim lastRow As Long
Worksheets("Sheet2").Columns("A").ClearContents
Application.ScreenUpdating = False
For c = 1 To 36 'AJ列が36列目
With Worksheets("Sheet1")
lastRow = .Columns(c).Find("*", , xlValues, xlPart, , xlPrevious).Row
.Range(.Cells(2, c), .Cells(lastRow, c)).Copy
End With
Set rng = Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp)
If rng.Value <> "" Then Set rng = rng.Offset(1, 0)
rng.PasteSpecial Paste:=xlPasteValues
Next
Application.ScreenUpdating = True
End Sub
【余談追加】
(1)
lastRow = .Columns(c).Find("*", , xlValues, xlPart, , xlPrevious).RoW
は結構色々な時に使えます。例えば、
lastRow = Columns("A:C").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
などとすると、どの列が最終行になっているか予め不明の場合にも、結果を出してくれます。
(2)
.Formula = .Formula というのは余り使ったことがなかったですね。
これで""が消えるわけですね。
.Value = .Value でもよいわけですが、私にとっては盲点でした。勉強になりました。
（γ） 2021/05/27(木) 06:26
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.