[[20060828163132]]　『マクロでの表の作り方』（shiiho）　ページの最後に飛ぶ

『マクロでの表の作り方』（shiiho）

初めまして、こんにちは。
Sheet1からSheet2へ内容を移動させるということをマクロで作成しているのですが、
なかなかうまくいきません。
お手数ですが、どなたか教えていただけませんでしょうか？

例）

sheet1

　　　　A　　　B　　　C　　　D　　　E　　　F　　

2　　　　　　支払日　氏名　　日付1　　　　日付2

3　　　　　　8/28　　aaa　　8/25 　　　　8/28

4　　　　　　8/29　　bbb　　8/25　　　　　8/28

sheet1は入力画面用として、B3～F19に入力ができるようにしています。

内容はsheet1のマクロボタンを押せば、sheet2のそれぞれの列の空白行へ移動され、入力した内容sheet1画面B3～B19は消去される。そしてその都度内容入力、sheet2空白行へ移動ができるように作成したいのです。

私が作成したマクロ内容は、いろいろな組み合わせで作ったので、全くうまくいきません・・・(T_T)

Sub オートシェイプ1_Click()

 Dim WBK As Workbook
    Dim SH1 As Worksheet
    Dim SH2 As Worksheet
    Set WBK = ThisWorkbook
    Set SH1 = WBK.Worksheets("sheet1")
    Set SH2 = WBK.Worksheets("sheet2")

  With SH2.Range("b" & Rows.Count).End(xlUp).Offset(1)
  .Value = SH1.Range("B3").Value

End With

SH1.Range("B3:F19").ClearContents
Range("B3").Select

End Sub

（sheet1に何か入力していれば、コード表からも動くのですが、入力していないと
コード表からではエラーが出ます。オートシェイプボタンでは大丈夫のようです。）

それと、設定がsheet1のB3だけ移動するようになっているので、そこしかsheet2へ移動されません。
うまく、sheet1のB3～F19の内容がsheet2のそれぞれの列の空白行へ毎度移動させれるようにするにはどうすれば良いのでしょうか？

マクロはほとんど、わかっておらず、いろんなものを組み合わせてつくりました。
すみませんが、どなたか教えてください<(_ _)>

 Sheet1 と Sheet2 の列の構成は同じものでしょうか。
 だとしたら、下記のような感じでどうでしょうか。

 Const inputRange = "B3:F19"   '--- 追加修正

 Sub オートシェイプ1_Click()
    Dim ws2LastRow As Integer
    ws2LastRow = Worksheets(2).Range("B1").CurrentRegion.Rows.Count + 1
    Range(inputRange).Copy Destination:=Worksheets(2).Range("B" & ws2LastRow)
    Range(inputRange).Value = ""
 End Sub

 (Mook)

MooKさん、回答ありがとうございました！！

出来ました>^_^<

それとですね・・・
引き続きお伺いしたいのですが、

sheet1 C3の氏名が"aaa"ならsheet1(B3:F3)の内容をsheet2へ、

sheet1 C4の氏名が"bbb"ならsheet1(B3:F3)の内容をsheet3へ、

という具合に各氏名別でsheetを作ってsheet1の内容をそれぞれのsheetへ振り分けたい

のですが、それは可能でしょうか？？

 可能かどうかといえば可能ですが、振り分けるとなるとデータの中身を見ないといけなくなるので、
 処理がだいぶ複雑になりますよ。
 集計したデータをフィルタで処理をすれば、名前ごとに表示できますが、それでは不十分でしょうか。

 もしシートごとに振り分けるとした場合、入力された名前がどのくらいありますか。
 同じ人の名前が誤入力される可能性はありませんか？

 プログラム中でシートの振り分け先を考えると、人が増えるたびにコードを変更しなければならない
 ので、私がやるとしたらシート名を名前とし、新しい名前が出たらシートを作成するといった感じに
 したいところです。

 ちょっと内容は異なりますが、以前あった質問が参考になりませんか？
[[20050721182519]]『一つのシートから各個人ごとに分割したシートを作る』
 (Mook)

Mookさん、ありがとうございます　>^_^<

以前あった質問はとっても参考になりました。

お手数をおかけしました(^^ゞ

自分なりに手を加えてみようと思い、

'---------------------------------

 Sub AddLine(lineNum%, sheetName$)
 '---------------------------------
    Dim lastLine%

    Call checkAndMake(sheetName)
    lastLine = Worksheets(sheetName).Range("C65535").End(xlUp).Row + 1
    Worksheets(1).Rows(lineNum).Copy
    Worksheets(sheetName).Rows(lastLine).Insert Shift:=xlDown
    Application.CutCopyMode = False

    Worksheets(1).Activate
    Range("A2:E20").ClearContents
    Range("A2").SelectRange("A2").Select

End Sub

入力して、内容が移動後に消去できるようしてみたのですが、エラーがでます・・・。

"OK"すると、一応内容は移動（？、コピーかな）できています。

ごめんなさい、再度、教えてもらえないでしょうか・・・　_(._.)_

わぁぁぁ、ごめんなさい！！

最後の

Range("A2").SelectRange("A2").Selectになっていました・・・

正しくしたら直りました(^^ゞ

また、何かわからない時、教えてくださいね　>^_^<

 お役に立ったようで何よりです。

 >マクロはほとんど、わかっておらず、・・・
 いやいや、サンプルもそのままでは動かないはずでしたが
 （inputRange の定義が抜けてましたので、修正）
 自力で解決されましたし、提示したサンプルも、きちんと自分の
 目的に合わせて修正されているあたり、十分 VBA を活用できている
 と思います。

 何はともあれ解決したようで、よかったですね。
 (Mook)

Mookさん、いろいろとありがとうございました(^o^)丿

コメント返信：

[ 一覧(最新更新順) ]

[[20060828163132]] 『マクロでの表の作り方』（shiiho） ページの最後に飛ぶ

[[20060828163132]]　『マクロでの表の作り方』（shiiho）　ページの最後に飛ぶ