エクセルのコピーについてご教示下さい。

質問

シートAのB4に日付が入っています。
C5からE10までのデータをシートBのD列に入ってる同じ日付の横に
ボタンひとつでコピーするようにしたいのですが出来るでしょうか。
例えば、シートBのD20に同じ日付があれば、ボタンを押せばE21からF25にコピーするようにしたいのです。
ただ、同じ日付がない場合もありますが、その時はコピーはしません。
どなたか、よろしくお願いいたします。

回答No.4

harapeco7 · ベストアンサー

ANo.3です。
＞一度無しと出ると、何度しても同じようになります。
正常に動作した日付で再度実行しても、無しと出るのでしょうか？
それとも特定の日付だけ、無しと出るのでしょうか？

今回は「特定の日付だけ無しと出る」について回答します。

前回のコードは
シートA－B4セルの「日付」がシートB－D列にあるか検索しています。
この時の「日付」はシリアル値を指し同じシリアル値があるかを検索しています。

例えばシートB－D1に　11/24　と「表示」されていたとします。
あくまでも「表示」しているだけであって実際の内容は
１．2008/11/24　0:00
２．2007/11/24　0:00
３．2008/11/24　0:30
４．ただの文字列の11/24
と見た目では同じ11/24であっても実際の内容が異なっている
場合があります。
この時の１．２．３．がシリアル値となります。
（詳しくは　シリアル値　で検索願います。）

今回のような日付（シリアル値）の検索がうまく動作しな
かった場合は見た目の勘違いを防ぐ為にも、該当するセル
の表示形式を変更する事をお勧めします。

シートA－B4セル、シートB－D列の表示形式を
西暦/月/日 時刻　などに変更し再確認してみて下さい。
（特にD列に時刻表示されていないセルが無いか確認して下さい。）
（時刻表示されていない＝シリアル値でない　という事です。）

お礼

お礼が少し遅くなりました。
ちゃんと動いて、コピーが出来るようになりました。
丁寧に教えていただき、ありがとうございます。
本当に助かりました。
今後ともよろしくお願いいたします。

回答No.3

harapeco7

＞ボタンひとつでコピーするようにしたいのですが出来るでしょうか。
こういった質問をする場合、マクロ（VBA）についてどのぐらい知識が
あるのか添えて頂けると回答側としては助かります。

極端な話、Ｑ．エクセルの「マクロ（VBA）」といった機能を使うと出来ます。
となってしまいます。

今回はコードの記述ついて回答します。
※バックアップを取ってから実行して下さい。
※貼り付け先の領域にデータが既に入っていても上書きします。

Sub test()

　　Dim sh1 As Worksheet
　　Dim sh2 As Worksheet
　　Dim ran As Range
　　Dim hi As Date

　　Set sh1 = Worksheets("シートA")
　　Set sh2 = Worksheets("シートB")

　　hi = sh1.Range("B4")

　　Set ran = sh2.Columns(4).Find(hi)
　　If Not ran Is Nothing Then
　　　　sh1.Range("C5:E10").Copy ran.Offset(1, 1)
　　Else
　　　　MsgBox "同じ日付無し"
　　End If

　　Application.CutCopyMode = False

　　Set sh1 = Nothing
　　Set sh2 = Nothing
　　Set ran = Nothing

End Sub

補足

昨夜は、早速のご教示ありがとうございました。
私は、マクロは、お教えいただいたものを本に添って標準モジュールに貼り付け使用する程度の素人です。
よろしく、お願いいたします。
早速、使用してみると、何度か日付を変えてやっている間に、途中から同じ日付があるのに、無しとでるようになりますが、日付の入力の仕方など、注意点があるのでしょうか。
特に、日付の書式を変えたようなことはしていませんが、一度無しと出ると、何度しても同じようになります。
よろしく、お願いいたします。

回答No.2

mitarashi

#1と同様ですが
Sub test()
With Worksheets(2).Range("d:d")
Set c = .Find(Worksheets(1).Range("b4").Value, LookAt:=xlWhole)
If Not c Is Nothing Then Worksheets(1).Range("c5:e10").Copy c.Offset(1, 1)
End With
End Sub

回答No.1

n_na_tto

シートAのC5からE10
↓
シートBのE21から【G26】ではないでしょうか？
でないとサイズが違ってしまいますよね？

Dim myShtA As Worksheet, myShtB As Worksheet
Dim myRngA As Range, myRngB As Range
Set myShtA = Worksheets("シートA")
Set myShtB = Worksheets("シートB")
Set myRngA = myShtA.Range("B4")
With myShtB.Range("D:D") 'シートBのD列の中だけ
　Set myRngB = .Find(myRngA.Value, LookIn:=xlValues) '検索して
　If Not myRngB Is Nothing Then 'もし見つかれば
　　'どちらの範囲も下に1,右に1移動、下に6,右に3拡大してまとめて代入
　　myRngB.Offset(1, 1).Resize(6, 3).Value = _
　　myRngA.Offset(1, 1).Resize(6, 3).Value
　End If
End With