『VBAのプログラムを教えて下さい』（まるてて）

VBA初心者です。
教えて欲しいことがあります。

●下のような表で、Ｂ８セルに入力した日付と同じセル(この場合Ｄ１)からＺＺ８のセルくらいまで選択し値のクリアをしたいです。

●次に、下の表と同じ様な表が別シートにあり（品名の並び順は同じ･日付は違います）、その表のＢ１からＺＺ８のセルくらいまでのデータを、上の?@でクリアしたＤ１以降に値の貼付けをしたいです。

※その前に、別シートの１行の日付で横昇順できれば助かります。

これをマクロの１ポチでやりたいのですが、色々調べてもわかりませんでした。

理由は、毎日来るデータが日付や数量がバラバラなので、１列ずつ貼付け直しをするのが効率が悪いので、皆様のお知恵をお借りしたいです。

よろしくお願い致します。


	A列	B列	C列	D列	E列	F列	G列
1行		9月12日	9月13日	9月17日	9月21日		
2行	りんご	2	6		4		
3行	みかん		4	3	8		
4行	梨	3			3		
5行	ぶどう	7		2			
6行	バナナ		1		4		
7行							
8行		9月17日					




＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
----
 ＞Ｂ８セルに入力した日付と同じセル(この場合Ｄ１)から
 ＞ＺＺ８のセルくらいまで選択し値のクリアをしたいです。
 
 「くらい」と言うのがちょっと曖昧なので「ZZ8」までとして
 
 １．ZZ列だと、700列位になりますが、正しいですね？
 ２．もしB8セルの日付が9/12だったら、その日付もクリアされますが、問題ないですか？
 
 
（半平太） 2023/09/26(火) 09:37:05
----
　いくつか確認。

＞●下のような表で、Ｂ８セルに入力した日付と同じセル(この場合Ｄ１)からＺＺ８のセルくらいまで

　1. この領域の 1 行目には必ず日付は入っているか。
　2. 7 行目にはデータがあるのか？？
　3. ZZ 列(くらい)より右側には何もない、もしくはクリアされても問題ないか。

　ちなみに 2 は半平太さんの 2 とも関係していて、日付(B8)の上の行が空行ならうれしい。
（higejee） 2023/09/26(火) 09:49:54
----
＞１列ずつ貼付け直しをするのが効率が悪いので、
数式バーの左にある名前ボックスを利用します。
名前ボックスに「D1:ZZ8」と入力して確定する。
範囲が選択された状態になる。
コピーして貼り付ける。

（IT） 2023/09/26(火) 09:54:07
----
早速ありがとうございます!!

半平太さん：
１．ZZは言い過ぎました(-_-;)実際は200列で充分です。
２．もしB8セルの日付が9/12で、その日付もクリアされても大丈夫です

higejeeさん
1. この領域の 1 行目には、日付しか入りませんが、空白列がある場合有りですが、不具合あれば空白列も無くして完全に日付のみにできます。
2. 簡単な表にしてしまいましたが、実際は日付行も入れて２９行あります。
　 B8の日付も仮で入れてしまい、実際B8の日付セルはどの場所(例えばA100など)でも大丈夫です。
3. ZZ 列(くらい)より右側には何もなく、クリアされても大丈夫です。

細かく聞いて頂いてありがとうございます。
何卒宜しくお願い致しますm(__)m

（まるてて） 2023/09/26(火) 10:07:36
----
ITさん　ありがとうございます。

日付の並びがバラバラで最初はそれを昇順にコピペで並べ直ししていましたが、マクロで昇順にできそうな感じがすると、欲が出て、別シートへの貼付けもマクロでできると、老若男女みんなができて間違いが無いなあと思いまして、1ポチがうれしいですm(__)m
（まるてて） 2023/09/26(火) 10:16:44
----
　ZZ とか 29 行とかは気にしないでいいようにはしてみましたが、当然シート名とはいくつか前提条件はあるので、そのまま動くかは保証の限りではありません。

　説明が省けるかと思って普段は使わない日本語変数名にしてみたが、なんか気持ち悪い。^^;

 Sub Sample()
     Dim 集計先   As Worksheet: Set 集計先 = Worksheets("集計先")
     Dim コピー元 As Worksheet: Set コピー元 = Worksheets("コピー元")
    
     '集計先のクリア
     Dim クリア範囲左端列 As Variant
     With 集計先
         クリア範囲左端列 = Application.Match(.Range("B8"), .Rows(1), 0)
        If IsError(クリア範囲左端列) Then Exit Sub
         .Range("A1").CurrentRegion.Offset(, クリア範囲左端列 - 1).ClearContents
     End With

     'コピー元の並べ替え
     Dim コピーデータ As Range   'ただし A 列は除く
     Set コピーデータ = コピー元.Range("A1").CurrentRegion
     Set コピーデータ = コピーデータ.Offset(, 1).Resize(, コピーデータ.Columns.Count - 1)

     With コピー元.Sort
         With .SortFields
             .Clear
             .Add Key:=コピーデータ.Rows(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
         End With
         .SetRange コピーデータ
         .Header = xlNo
         .Orientation = xlLeftToRight
         .Apply
     End With
     コピーデータ.Copy
     集計先.Cells(1, クリア範囲左端列).PasteSpecial _
         Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
     Application.CutCopyMode = False
 End Sub
（higejee） 2023/09/26(火) 10:57:55
----
higejeeさん

できました(ﾟДﾟ;)!!!
ありがとうございました(*^^*)

これで作業効率が上がります〜m(__)m

他の方もありがとうございました。
またよろしくお願い致します〜(^^ゞ

（まるてて） 2023/09/26(火) 13:49:04