複数行を最終行に転記

質問

ブックから他ブックへの複数行を最終行に転記したいと考えております。
1日1行であれば転記出来るものの、1日が複数行となると1日の最終行のみが転記され困っております。

縦カレンダー仕様
・月初ではなく日曜始まりの為前月含むこともあり
・1日につき各4行づつ
・4行すべて毎日データーが入るわけではなく時々入る程度

スケジュール表仕様
・日曜始まりの一週間毎のシート
・1日につき9行分

1か月分だと長いので1週目分だけですが…
Activ bookを縦カレンダー(入力用シート)
Thisbookをスケジュール表(転記先シート）

Sub 転記_Click()

Dim WBK1 As Workbook,WBK2 As Workbook
Dim SH1 As Worksheet,SH2 As Worksheet
Dim myRow1 As Long,myRow2 As Long,myRow3 As Long,myRow4 As Long_
myRow5 As Long,myRow6 As Long,myRow7 As Long

Set WBK1 = ThisWorkbook '縦カレンダー
Set WBK2 = ActiveWorkbook 'スケジュール表
Set SH1 = WBK1.Worksheets("1週目") 'スケジュール表
Set SH2 = WBK2.Worksheets("3月") '縦カレンダー
Set SH3 = WBK1.Worksheets("2週目") 'スケジュール表
Set SH4 = WBK1.Worksheets("3週目") 'スケジュール表
Set SH5 = WBK1.Worksheets("4週目") 'スケジュール表
Set SH6 = WBK1.Worksheets("5週目") 'スケジュール表
Set SH7 = WBK1.Worksheets("6週目") 'スケジュール表

With SH1
myRow1 = SH1.Range("C1").End(xlDown).Row '日
myRow2 = SH1.Range("C12").End(xlDown).Row '月
myRow3 = SH1.Range("C23").End(xlDown).Row '火
myRow4 = SH1.Range("C34").End(xlDown).Row '水
myRow5 = SH1.Range("C45").End(xlDown).Row '木
myRow6 = SH1.Range("C56").End(xlDown).Row '金
myRow7 = SH1.Range("C67").End(xlDown).Row '土

SH1.Range("C" & myRow1 + 1 & ":J" & myRow1 + 1).Value = SH2.Range("C3:J6").Value '日
SH1.Range("C" & myRow2 + 1 & ":J" & myRow2 + 1).Value = SH2.Range("C7:J10").Value '月
SH1.Range("C" & myRow3 + 1 & ":J" & myRow3 + 1).Value = SH2.Range("C11:J14").Value '火
SH1.Range("C" & myRow4 + 1 & ":J" & myRow4 + 1).Value = SH2.Range("C15:J18").Value '水
SH1.Range("C" & myRow5 + 1 & ":J" & myRow5 + 1).Value = SH2.Range("C19:J22").Value '木
SH1.Range("C" & myRow6 + 1 & ":J" & myRow6 + 1).Value = SH2.Range("C23:J26").Value '金
SH1.Range("C" & myRow7 + 1 & ":J" & myRow7 + 1).Value = SH2.Range("C27:J30").Value '土
　 End With
End Sub

回答No.3

imogasi

人間では（プログラムを考えなければ）直感的にわかるが、ＶＢＡでは複雑になりそうに思う。
私の提案
「スケジュール表」、「縦カレンダー」ともＡ列には日付（日付シリアル値に限る。表示形式は日だけでもよい）を入れてほしい。
すると、「スケジュール表」の、ある週のこのシートの日付のＷＥＥＫＮＵＭ値は同じである日付だけになる。
ーーー
疑問
「縦カレンダー」は月ごとらしいが、月初日が日曜から始まらない場合は、どちらの月に入れるのか？たとえば２０１６年３月は１日が火曜日だが、２月シートに入れるのか、または２月２８日（日）から３月に入るのか。
どちらのシートに持っていくのかな。
こういうのは仕様的にむつかしくなると思う。
どちらかに決めても、常識として定着しておらず、使う方も、どちらのシートにあるのか迷うのではないか。
ーーー
上記は小生が質問内容を誤解していたら、補足しておいてください。
勿論、既出のご回答（ＶＢＡ）でＯＫだったなら補足する必要はなく、締め切ってください。
---
また
他ブックのシートや同一のブックの他シートに、データを持っていく（移動でなくコピーと思うが）
・各行の代入法の行数分繰り返しではなく
・セル範囲のデータのコピーと貼り付けを使うと、コードの行数が少なくなるのではないか。

回答No.2

imogasi

小生だった（小生の質問を読んでの理解では）ら、質問は下記のように書く。
コードなど載せない。
勉強と思って読んで、下記で言っていることことを考えてみてください。
小生の質問の理解が間違っている場合は補足してください。
VBAコードを考えるとか、質問する前に自分で考えたり、読者に説明することがあるのではないか。
（Ａ）１週間のスケジュール表が集まったＢＯＯＫ１つ
　　　各週分は１シートになっている（分かれている）
　　　１週は日曜日から土曜日まで。
　　　月を越えても、同じブック内のシートに記録していくのかな？？
（Ｂ）月間スケジュール表
　　　質問では「縦カレンダー」と称す。月を越えて（Ａ）を縦方向に累積する。
　　　決めた１シートに累積する。
　　　月を越えても、同じ１つのシートに累積していくのかな？？。
この質問は（Ａ）の、あるシートから、（Ｂ）の最終行の次行以下に転記（累積）していく
課題らしい。
ーー
以下のことが書いてないようだが、システム的考慮が質問者には不足してないか。
それは作業単位が書いてないではないか？
移す作業の単位は（前）日、（前）週、（前）月分（または随時）のどれか？
どうも週単位らしいがいかがか？
累積作業を忘れることは考えなくてよいのか？
ーー
スケジュール通りに前（日、週、月、回）までは、転記作業が終わっているのは確実といえるのか。
それをきっちりしないとある週分データが飛んで累積されたりするよ。
ーー
小生のお勧めの思い付き
質問者は週単位にこだわっているようなので、ＷｅｅｋＮｕｍ関数のことを知っているか。
エクセル関数やVBA関数にはＷＥＥＫＤＡＹＮＵＭ関数があり、スタート曜日が日曜か月曜か選べる。
これを使って（Ｂ）の（累積していっている１）シートの最終行！（前回の持ってきた最近の週）の日付のＷＥＥＫＤＡＹＮＵＭの数を、知り、それに＋１したＷＥＥＫＤＡＹＮＵＭのスケジュール記録のある（A)の中のシートを探す。見つかればそのシートの全行（見出しなど除く）をＣｏｐｙして、（Ｂ）のデータの最終行の次行以下に貼りつける（Ｐａｓｔｅする）。
１週間飛んでいる場合は、次の週も割り出さないといけないが、工夫すれば、累積を忘れていても自動で補うことは可能ではある。
以上でよければコードを考えてみるが、データ例が作りにくいので面倒です。質問者でやってほしいが。

補足

(A)月を越えても、同じブック内のシートに記録していくのかな？？
→１か月毎です。
ーー
(B)月を越えて（Ａ）を縦方向に累積する。
→これも１か月分のみです。
ーー
作業単位が書いてないではないか？
→翌月予定の表になりますので、1日づつでも1週間づつでも構いません。
ーー
累積作業を忘れることは考えなくてよいのか？
→1か月分入力が終わると（Ｂ）月間スケジュール表は変更せずそのまま1年保存になります。
（Ａ）１週間のスケジュール表が集まったＢＯＯＫ１は、変更の際に直接このブックに入力して変更となりその月が終わると年単位で保存になるので、転記でつかわれるのは1回のみです。
A・B共に原本を用意しておき1か月毎にVBAの記載のある新しいブックを使い入力していく予定ですがそれでも累積作業は必要でしょうか。
ーー
スケジュール通りに前（日、週、月、回）までは、転記作業が終わっているのは確実といえるのか。
→申訳ありません、おっしゃって下さっている意味が分かりません。

今月初めに会社役員(PCを打つのに人差し指のみで打つ人)が自分もしたいと言い出して手を出しデーターが没になり、それを直すのに時間を取られ…コピー貼り付け作業ですら聞きに来られると仕事がままならないので、打ちさえすればB→Aブックにボタン一つで転記できるようにしたいと思っている次第です。
ちなみに私もPC初心者で、先日エクセルにこんな機能(VBA)があるんだと知ったレベルです。

回答No.1

dogs_cats

一例です。
月のシート名を自動で指定する為に１週目のB1データから数値を取得、日付データであるとしてmonth関数としています、整数で指定の場合はmonth関数削除し、B1の値を使用して下さい。

6周目が無い月は値をコピーしないようにしています。
6周目シートのA3が10以下であれば6周目は不要としました。
A3の値が日付であると思いday関数で日にちを取得しています。整数で対応している場合はday関数を削除して下さい。

Sub test()

Dim WBK1, WBK2 As Workbook
Dim SH1, SH2 As Worksheet
Dim myRow1 As Long
Dim i, j, k, tuki As Integer

Set WBK1 = ThisWorkbook '縦カレンダー
Set WBK2 = ActiveWorkbook 'スケジュール表

'月を整数で取得
tuki = Month(WBK1.Worksheets("1週目").Range("B1").Value)

'6週目が翌月から開始されてる場合は5周で終了
If Day(WBK1.Worksheets("6週目").Range("A3").Value) < 10 Then
k = 5
Else
k = 6
End If

Set SH2 = WBK1.Worksheets(tuki & "月") '縦カレンダー

myRow1 = 3

With SH2

For i = 1 To k

Set SH1 = WBK2.Worksheets(i & "週目")

j = 3

For k = 1 To 7
.Range("C" & myRow1 & ":J" & myRow1 + 3).Value = SH1.Range("C" & j & ":J" & j + 3).Value

myRow1 = myRow1 + 11
j = j + 4

Next

Next

End With

End Sub