UserFormを利用してシートからシートへコピー

質問

お世話になっています。
UserFormに日付を入力したら、シート1に入力してあるデータをシート2にコピーをさせたいのですが出来ますでしょうか？

シート1には、下記のようなデータがあります。
UserFormを作成し、その中には【TextBox】・【CommandButton】があり【TextBox】に日付を入力し【CommandButton】をクリックすると、シート2にそのデータがコピーされるようにしたいのですが・・・
（ちなみに、日付はバラバラに入っています）

シート1
　 A　　　B　　　　　　C　　　　　D　　　　E
・
・
・
7 No.　　　日付　　　　商品名　　　　金額　　　仕入先
8 1　　2008/03/10　　　○○○
9 2　　2008/03/10　　　○○○
10 3　　2008/03/14　　　○○○
11 4　　2008/03/13　　　○○○
12 5　　2008/03/12　　　○○○
13 6　　2008/03/11　　　○○○
14 7　　2008/03/12　　　○○○
15 8　　2008/03/13　　　○○○
・ ・　　　・
・ ・　　　・
・ ・　　　・

2008/03/12を入力した場合、

シート2
　 A　　　B　　　　　　C　　　　　D　　　　E
・
・
・
7　　　日付　　　　商品名　　　　金額　　　仕入先
8　　2008/03/12　　　○○○
9　　2008/03/12　　　○○○
10
11
12
13
14
15
・ ・　　　・
・ ・　　　・
・ ・　　　・

回答No.4

imogasi

＞出来ますでしょうか
どれだけやってみたの。質問は丸投げでやってくださいという風だよ。
ベテランにかかればほとんどのことは出来る。「こうやったがここでうまくいきません」というのがあるべき姿だよ。
ーー
この課題を解決するために、どういう要素技術が必要か考えましたか。
ものは全て、部分に分解して、その部分を組み合わせて、総合するのだ。

ーー
＞UserFormに日付を入力したら、
その日付を抜き出し条件に使うということか。質問の結果を見ると、そうらしいが、質問に明記のこと。
ーー
要素技術
（１）コマンドボタンをクリックしたら、実行するイベントプロシジュアー　　これぐらいわかっているでしょう。
Private Sub CommandButton1_Click()
test03
End Sub
test01は仮に書いておくメイン処理のプロシージュアー名
（２）シート１、シート２は固定のシートらしい。
シート１を対象に－－＞指定日付で選別ーー＞シート２に書き込む。
選別はB列の日付が、ユーザーフォームの日付と同じか、IF文で判別
するぐらい判るだろう。
（３）ユーザーフォームのテキストボックスの日付は、文字列で、エクセルの日付で使う日付シリアル値とは違うので、関数で変換して比較しないといけない。この点意識しましたか。
DateValue(文字列日付)
TextBox1の値のとり方ぐらいは判っているね。
（４）シートが２つ扱うので、その区別を当然必要だが、どうするか
勉強しましたか
（５）値を移す方法は色々ある。コピーを思いつく人が多いが、値代入法が本件では良い。
（６）シート１のデータ行全行について、繰り返しになるというのは予想できますか。
繰り返しは、For Nextが簡便。
ーー
ユーザーフォーム１のコード
Private Sub CommandButton1_Click()
MsgBox UserForm1.TextBox1.Text
dt = DateValue(UserForm1.TextBox1.Text)
MsgBox dt
test03
End Sub
ーー
標準モジュール
Public dt
Sub test03()
MsgBox dt
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("A65536").End(xlUp).Row
MsgBox d
k = 1
For i = 1 To d
If sh1.Cells(i, "A") = dt Then '実際はＢ列
For j = 1 To 5 'Sheet1のE列までを仮定
sh2.Cells(k, j) = sh1.Cells(i, j)
Next j
k = k + 1
End If
Next i
End Sub
ーー
例データ
Ｓｈｅｅｔ１
Ａ列　　Ｂ列　　Ｃ列　　Ｄ列
2008/3/1 9A54 1
2008/3/2 9A55 2
2008/3/3 9A56 3
2008/3/4 9A57 4
2008/3/5 9A58 5
2008/3/6 9A59 6
2008/3/7 9A5A 7
2008/3/8 9A5B 8
2008/3/9 9A5C 9
2008/3/12 9A5F A A
2008/3/11 9A5E B
2008/3/12 9A5F A C
2008/3/13 9A60 D
2008/3/14 9A61 E
2008/3/15 9A62 F
2008/3/16 9A63 1
2008/3/17 9A64 2
2008/3/18 9A65 3
2008/3/19 9A66 4
2008/3/12 9A5F A 5
2008/3/21 9A68 6
2008/3/22 9A69 7
2008/3/23 9A6A 8
2008/3/24 9A6B 9
2008/3/25 9A6C A
2008/3/26 9A6D B
2008/3/27 9A6E C
ーー
結果
Ｓｈｅｅｔ２
2008/3/12 9A5F A A
2008/3/12 9A5F A C
2008/3/12 9A5F A 5
実際やってみると、ちょっとした、色々の知識が上記以外も必要だった。質問者の現状の力では課題として無理ではないかという感想。
Private Sub CommandButton1_Click()
test03
End Sub
のtest03の部分に、Test03の中身のコードを突っ込むほうが良いかも。

回答No.3

okormazd

ANo.1
です。

hizuke = UserForm3.TextBox1.Value
で、
UserForm3
になっているが、
適当なformに変更して。

回答No.2

mitarashi

ほとんど自動記録したコードです。ご笑納下さい。
前提：元データはSheet1のA1からの表にある。転写先はSheet2のA1である。複写するのは値のみである。
'Module1に記述
Sub test()
UserForm1.Show
End Sub

'UserForm1に記述
Private Sub CommandButton1_Click()
Sheets("Sheet1").Activate
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:=DateValue(TextBox1.Text), Operator:=xlAnd
Range("A1").Select
Selection.CurrentRegion.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Sheet1").Activate
Selection.AutoFilter
Range("A1").Select
End Sub

回答No.1

okormazd

例
CommandButton1のコード

Private Sub CommandButton1_Click()

copy1to2

End Sub

標準モジュールのコード

Sub copy1to2()

Dim sh1 As Object, sh2 As Object, hizuke As Date

Set sh1 = ActiveWorkbook.Sheets("sheet1")
Set sh2 = ActiveWorkbook.Sheets("sheet2")

hizuke = UserForm3.TextBox1.Value

r1 = 2
c1 = 2

r2 = sh2.Cells(65536, 2).End(xlUp).Row + 1
c2 = 2

With sh1

day1 = .Cells(r1, c1)
While day1 <> ""
If day1 = hizuke Then
sh2.Cells(r2, c2) = .Cells(r1, c1)
sh2.Cells(r2, c2 + 1) = .Cells(r1, c1 + 1)
sh2.Cells(r2, c2 + 2) = .Cells(r1, c1 + 2)
sh2.Cells(r2, c2 + 3) = .Cells(r1, c1 + 3)
r2 = r2 + 1
End If
r1 = r1 + 1
day1 = .Cells(r1, c1)
Wend

End With

End Sub