エクセルのマクロで対象ごとにシート分けしてその内容をセルに書き込みたい

EXCELマクロ初心者です。

マスターシート(Sheet1)にある表が「シート分け」ボタンを押されると
「名前」列(A列)にある名前ごとにシート分けし、そのシート分けしたものに「野菜」列を表示する処理を追加思っています。

[名前] [野菜]
佐藤　　だいこん
井上　　レタス
佐藤　　にんじん

これがマスターシートの場合は
[佐藤]というシートが作成され、作成されたシートのA1には「だいこん」、A2には「にんじん」と表示されるようにしたいです。


色々検索をし、

①マスターシートをフィルタ掛けする(AutoFilter処理)
②フィルタ掛けした結果のA列セルの名前を新しいシートに作成(Worksheets.Add処理)
③フィルタ掛けした結果を操作する(SpecialCell処理)
④フィルタ掛けした結果のB列を対象分(A1～個数分)を対象のシートのセルにA行に書き込む

このようにすればうまくいきそうな気はするのですが、最後の④の処理以降つまづいてしまっています。
そもそもの①からのやり方がよくないからうまくいかないのか、④の構文が間違っているからうまくいかないのかでお手上げ状態です。

For I = 1 To xCol.Count

Call Worksheets(Sheet1).Range("A1:B1").AutoFilter(1, CStr(xCol.Item(I)))
'変数「xNSht」を初期化
Set xNSht = Nothing
'変数「xNSht」にそれぞれのワークシート名を入れる(佐藤,井上)
Set xNSht = Worksheets(CStr(xCol.Item(I)))

'シートが見つからない場合
If xNSht Is Nothing Then
'新しくシートを挿入
Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
'新しくできたシート名を「Sheet1」のA2以降のセルの名前にする
xNSht.Name = CStr(xCol.Item(I))
'すでにシートがある場合
Else
'一番後ろのシート後方に移動する
xNSht.Move , Sheets(Sheets.Count)
End If

　　 '絞り込んだセルの行のみ操作
Dim rowCounttest As Integer
With xNSht.Range("A1").CurrentRegion
'見出しを除いて表示している行をループ
For Each a In .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).Rows
rowCounttest = 1
Range("A" & rowCounttest).Value = a.Cells(1, 2)
Next
End With

Next

一部変数の宣言部分などは省略をしていますが、①～④の処理はこのように入力しています。
'絞り込んだセルの行のみ操作 部分が何か間違っているような感じもするのですが、お力添えいただければと思います。
よろしくお願いいたします。

質問者からの補足コメント

• 1.変数xColについては
  Dim xCol As New Collection
  で宣言しております。
  
  2.シートが存在した場合にはそのシートに上書きをしていく想定で考えております。
  
  3.マスターシートの1行目は見出しになっています。
  
  
  実際には、マスターシートは30行、30列ぐらいあり、
  「佐藤」のC列の文字を
  「佐藤」シートのF1,F2
  というように
  「佐藤」のC列が複数個存在する場合にはここに書き込むよ、と指定をしたいです。

  No.2の回答に寄せられた補足コメントです。 補足日時：2022/08/25 11:14

• 変数xColについては
  Dim xCol As New Collection
  で宣言しております。
  
  実際にはマスターシートは30行、30列ぐらい存在し、
  作成したシートにそのまま書き込むのではなく「作成したシートのこのセルに書き込む」ということをしたいです(「佐藤」の「野菜」の場合には「佐藤」シートのC1～C2...というように)
  
  Range.SpecialCells(xlCellTypeVisible).Copy ～～～
  でセルをコピーできることは理解できたのですが、たとえば5行目にある「佐藤」のF列(F5)をコピーして「佐藤」シートのC2に書き込みたいという場合にはどのような処理を行えばよいのでしょうか。
  
  シートの存在チェックは別の方でシートがない場合にはシート新規作成という処理を追加しているのでエラーが発生しないようになっています(省略してしまい申し訳ございません)

  No.1の回答に寄せられた補足コメントです。 補足日時：2022/08/25 11:20

• 伝え方が正確ではなく申し訳ないです。
  
  仮に「佐藤」のシートが存在する場合には、もうひとつの「佐藤」シートは作成せずに、既存の「佐藤」シートに書き込むという処理をしたいです。
  
  マスターシートに
  
  佐藤　トマト　60
  井上　レタス　150
  佐藤　きゅうり 60
  佐藤　にんじん 90
  
  とあった場合は、「佐藤」シート1つ作成され、
  
  「佐藤」シートの
  C列　D列
  トマト　60
  きゅうり 60
  にんじん 90
  のような感じです。

  No.3の回答に寄せられた補足コメントです。 補足日時：2022/08/25 11:52

No.9 ベストアンサー 回答者： tatsumaru77 回答日時： 2022/08/26 10:47

下記にアップしました。

https://ideone.com/F6ukvx

注意事項：
１．転記対象となる列は、マスターのB,C,D,E列のみ記述しています。
必要であれば、下記に追記してください。
col_arr = Array("B|A|0", "C|F|0", "D|G|1", "E|H|0")
を
col_arr = Array("B|A|0", "C|F|0", "D|G|1", "E|H|0","●|○|X")
のように追加します。
●がマスターの列
○が名前シートの列
Xが補正値です。

"B|A|0"を例にとると
マスターのB列を名前シートのA列に転記する。
補正値が0なので3,6,9・・・行へ転記する。

"D|G|1"を例にとると
マスターのD列を名前シートのG列に転記する。
補正値が1なので3,6,9・・・行に1を加算した行へ転記する、したがって、4,7,10・・・行へ転記する。

となります。

２．'事前設定処理
Private Sub set_ws_before(ws As Worksheet)
については、
ws.Cells.ClearContents（名前のシートクリア）
以外は、コメントにしてあります。
まずは、この状態で実行し、名前のシートの各セルに正しく転記されることを確認してください。
それが、完了後、コメント部をはずして、実行してください。
このコメント部については、あなたの責任で実行してください。

３．'事後前設定処理
Private Sub set_ws_after(ws As Worksheet)
については、もし、必要があれば、ここに処理を追加してください。
事後前設定処理が不要であれば、この処理自体を削除しても構いません。
（その場合は、呼び出している個所も削除します）

この回答へのお礼

いただいたURLのマクロを実行したところ、希望通りの動きをしてくれました！

何度も小出しになってしまい、複数回の回答を頂いてしまい申し訳ございませんでした。
親切・丁寧なご対応本当にありがとうございました！

お礼日時：2022/08/26 16:30

No.8 回答者： tatsumaru77 回答日時： 2022/08/25 22:12

補足ありがとうございました。

最終確認です。
１．マスターの転記元の列と名前のあるシートの転記先の列は、規則性がないので、マクロ内で、その情報をもつ必要があります。
転記元列->転記先列
B->A
C->F
D->G
のような情報です。

２．転記先の行番号は、以下の規則で間違いないでしょうか。
転記元の1番目->転記先の3行
転記元の2番目->転記先の6行
・・
転記元のN番目->転記先の3×N行
（但し、転記先がG列の場合は、1行加算する）

３．下記の件ですが
>処理の中で
>Range("A1:J5").Merge
>Range("A1").Value = "食べ物依頼"
>・・以下省略・・・
>などのように記述をしている部分があります。

A1：J5をマージすると１つのセルになります。
そうすると、転記先がA3,F3,G3の場合は、この結合セル内に組み込まれてしまい、設定しても意味がなくなります。

①転記元の1番目は転記先の3行ではなく、６行がただしい。
②もしくは、Range("A1:J5").Mergeではなく、Range("A1:J2").Mergeが正しい。
のどちらかでないと、整合性が取れません。
①②のどちらでしょうか。もし、どちらでもないなら、
何が正しいのでしょうか。

この回答へのお礼

転記元列->転記先列に関しては

B->A
C->F
D->G

転記先の行番号に関しては

転記元の1番目->転記先の3行
転記元の2番目->転記先の6行
・・
転記元のN番目->転記先の3×N行
（但し、転記先がG列の場合は、1行加算する）

で間違いございません。

セルを連結している部分に関しては、
【やりたい処理部分だけをざっくり質問すればよいかな】と思ってしまっていたため、記述があいまいになってしまっていますが、今回の場合は②の「Range("A1:J2").Merge」が正しいになります。

たびたびご返信くださいましてありがとうございます。
お手数をお掛けして申し訳ございません。

お礼日時：2022/08/26 10:19

No.7 回答者： めぐみん_ 回答日時： 2022/08/25 19:24

No.５です。

何か最初の質問とはずいぶん膨れ上がった内容になっているのかな？
余り小出しで条件を出されると回答する側もそれに合わせて資料を作り替えなきゃならないので、最初からどれ程の規模の物なのかを提示された方が宜しかったのではないかな？

内容が今一つ不明ですがマスターシートはデータベースにして作れば楽な気もしますけれど。
⇒案件が戯言にしかならない点はご容赦を。

この回答へのお礼

【やりたい処理の部分をざっくり質問すればよいかな】と思ってしまっていたため小出しで膨れ上がってしまい申し訳ございませんでした。

たしかに、全部をマクロで完結しようとしか考えていませんでしたが、データーベースにしてしまえば楽だったのかもしれません。

色々とご助力をいただきましてありがとうございました。

お礼日時：2022/08/26 10:20

No.6 回答者： tatsumaru77 回答日時： 2022/08/25 15:51

No4です。

補足ありがとうございました。
転記元であるマスターシートのセル位置と名前のあるシートの転記先のセル位置には
汎用的な規則性がないと理解しました。
そうなると、マスターシートのセル位置と名前のあるシートの転記先のセル位置の
全てのケースを提示していただかないと、具体的なマクロでのソースコードの回答は
できません。

マスターシートのB列を名前シートのC列に転記
転記元の1番目を転記先の3行に転記
転記元の2番目を転記先の6行に転記
・・・

マスターシートのC列を名前シートのF列に転記
転記元の1番目を転記先の3行に転記
転記元の2番目を転記先の6行に転記
・・・

マスターシートのD列を名前シートのG列に転記
転記元の1番目を転記先の4行に転記（ここだけが4行になっている）
転記元の2番目を転記先の6行に転記
・・・

マスターシートの〇列を名前シートの●列に転記
転記元の1番目を転記先の??行に転記
転記元の2番目を転記先の??行に転記
・・・


①マスターシートの〇列を名前シートの●列に転記
○は、E,F,G,H・・・
●は、上記のE,F,G,H・・・の転記先のセル
②各列ごとの・・・の箇所（3番目～最後まで）を全て提示してください。

私が気が付かないだけで、汎用的な規則があるのかもしれません。
もし、汎用的な規則がある場合は、その汎用的な規則を提示してください。


追伸
No4の添付図で、B2のだいこんのセルが空白のケースはあるのでしょうか。
もし、ある場合は、B4のにんじんは、佐藤のC3に転記でしょうか。
それとも、佐藤のC6に転記でしょうか。（この場合佐藤のC3は空白）

この回答へのお礼

度々のご回答ありがとうございます。

転記元であるマスターシートは「貼り付けシート」という名前に実際はなっており、別のエクセルにある表を貼付けするものになっております。
このマスターシートに貼り付けたセルは50列ぐらいを想定しており、行数は貼り付けするデータによって可変となります。

本来の目的で、「佐藤」「井上」などのシートにはきれいに整形された明細書みたいな表示にするため、「貼付けシート」から転記されたデータ以外にも

処理の中で

Range("A1:J5").Merge
Range("A1").Value = "食べ物依頼"
Cells.Font.Name = "Meiryo UI"
Range("A1").Font.Size = 20
Range("A1").Font.Bold = True
Range("A1").Cells.HorizontalAlignment = xlCenter

などのように記述をしている部分があります。

ただ、マスターシートのセル一と名前のあるシートの転記先セル位置には法則性があり

マスターシートのB列「野菜」を名前シートのA列に転記
転記元の1番目を転記先のA3行に転記
転記元の2番目が存在するならば転記先のA6行に転記
※転記元の2番目が存在しないならA3行に転記のみ(以下同
・・・

マスターシートのC列「くだもの」を名前シートのF列に転記
転記元の1番目を転記先のF3行に転記
転記元の2番目が存在するならば転記先のF6行に転記
・・・

マスターシートのD列「さかな」を名前シートのG列に転記
転記元の1番目を転記先のG4行に転記
※（ここだけが4行になっている　に関しては、明細書表示にする際に別の文字が入るためG4に転記になっています。G列に転記の場合のみ1行ずれます
転記元の2番目が存在するならば転記先のG7行に転記
・・・

マスターシートのE列「おにく」を名前シートのH列に転記
転記元の1番目を転記先のH3行に転記
転記元の2番目が存在するならば転記先のH6行に転記
・・・

このあとにも列は続いていきますが、すべて転記先シートの決められたセルに転記していきます。

B2のだいこんのセルが空白になることはなく、マスターシートの表はすべて何かしらの文字があります。

お礼日時：2022/08/25 17:45

No.5 回答者： めぐみん_ 回答日時： 2022/08/25 13:19

No.3の補足について。

'すでにシートがある場合
Else
'一番後ろのシート後方に移動する
xNSht.Move , Sheets(Sheets.Count)

これの意味が分からなかったのです。
どうしてシートが存在する度に後ろへと移動させるのか？です。

'シートが見つからない場合
If xNSht Is Nothing Then
'新しくシートを挿入
Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
'新しくできたシート名を「Sheet1」のA2以降のセルの名前にする
xNSht.Name = CStr(xCol.Item(I))
'一番後ろのシート後方に移動する
xNSht.Move , Sheets(Sheets.Count)

'※すでにシートがある場合は何もしない

End If

で宜しいのではないかなと。
あとは回答もついているようですので（見えないですが）疑問に感じた部分だけを。

追伸：

＞'絞り込んだセルの行のみ操作

行の表示・非表示で判定するか、可視化しているセル全体を纏めてコピーが楽かなってのはありますが、スマホでコード打ち込める（スペルミス）自信ない物で。

この回答へのお礼

マクロの知識がほぼないので色々なところから引っ張ってきたため、処理内容がもしかしたらおかしくなってしまっていたのかもしれません。

https://ja.extendoffice.com/documents/excel/3197 …
こちらのサイトから引用しました。

たしかに

'すでにシートがある場合
Else
'一番後ろのシート後方に移動する
xNSht.Move , Sheets(Sheets.Count)

は必要ないですね。
ご助力いただいたものに変更して色々試行錯誤してみようと思います。

お礼日時：2022/08/25 14:21

No.4 回答者： tatsumaru77 回答日時： 2022/08/25 11:58

補足ありがとうございました。

＞実際には、マスターシートは30行、30列ぐらいあり、
＞「佐藤」のC列の文字を
＞「佐藤」シートのF1,F2
＞というように
＞「佐藤」のC列が複数個存在する場合にはここに書き込むよ、と指定をしたいです。

意味がよくわかりません。
マスターシートの列と佐藤シートの列の関係は決まっていないのでしょうか。
例えば、添付図のように佐藤シートへ設定するのかと思ったのですが、
違ってますか。
その場合、
マスターのB列ー＞佐藤のA列
マスターのC列ー＞佐藤のB列
マスターのD列ー＞佐藤のC列
のようにマスターの列を1列左にずらした列が佐藤の列になります。

マスターの列と佐藤の列にはどのような関係がありますか？

この回答へのお礼

＞意味がよくわかりません。
＞マスターシートの列と佐藤シートの列の関係は決まっていないのでしょうか。

説明下手で申し訳ございません。

マスターのB列ー＞佐藤のA列
マスターのC列ー＞佐藤のB列
マスターのD列ー＞佐藤のC列

のように1列左にずらすのではなく、

マスターのB2ー＞佐藤のC3
マスターのB4ー＞佐藤のC6
マスターのC2ー＞佐藤のF3
マスターのC4ー＞佐藤のF6
マスターのD2ー＞佐藤のG4

というように佐藤シートのそれぞれの決められた位置に設定したいです。

井上の場合には

マスターのB3ー＞井上のC3
マスターのC3ー＞井上のF3

というような感じです。
仮にマスターシート5行目に井上が出てきた(井上　きゅうり　みかん)場合は

マスターのB5(きゅうり)ー＞井上のC6
マスターのC5(みかん)ー＞井上のF6

といったように

それぞれ「佐藤」「井上」等作成されたシートの

1つ目の野菜はC3、2つ目の野菜はC6
1つ目のくだものはF3、2つ目のくだものはF6
1つ目のさかなはG4、2つ目のさかなはG6

へ入れたいです。

お礼日時：2022/08/25 12:37

No.3 回答者： めぐみん_ 回答日時： 2022/08/25 11:22

シートの存在の有無でなしの場合はわかるのですが、有の場合（２個以上）ですと都度一番後ろに移動って事になるのですが、絞り込んでいるのなら同じ値しか現れないんじゃないかと初級レベルは思うのです。

それとも何か狙いがあってでしょうか？

No.2 回答者： tatsumaru77 回答日時： 2022/08/25 09:51

補足要求です。

１．xColの定義とxColに名前を設定している個所があるはずですが、
それを提示していただけませんでしょうか。

２．名前のシート（例 "佐藤"）が既に存在した場合は、そのシートのA1から上書きしていくのでしょうか。
上書きの場合、シートのA1,A2,A3が設定されているなら、
A1には「だいこん」、A2には「にんじん」となります。
A3は前の値が残ります。
それとも、追加していくのでしょうか。
追加の場合、
A4には「だいこん」、A5には「にんじん」となります。
A1,A2,A3は前の値が残ります。

３．マスターシートの1行目は見出しでしょうか。
それとも、いきなり"佐藤"、"だいこん"等のデータでしょうか。

No.1 回答者： fujillin 回答日時： 2022/08/24 15:52

こんにちは

変数 xCol の内容の説明がないので、よくわかりませんけれど・・


ちゃんとフィルターをかけられているのなら、個々のセルをコピペしなくても、セル範囲をコピペしてしまえば、表示セル（＝フィルターの結果）だけをペーストできます。
きちんと明示的に記述したいのなら、
　Range.SpecialCells(xlCellTypeVisible).Copy ～～～
等のようにしておけば、「可視セル」が対象になります。
https://docs.microsoft.com/ja-jp/office/vba/api/ …

常に新しくSheet1の内容を反映するだけ（＝追加などではなく）なら、最初にそれ以外のシートを削除してしまえば、シートの有無のチェックの必要はなくなるでしょう。
　・シート作成
　・コピペ
の処理のループで済むようにできると思われます。

また、シートの存在チェックを
　＞Set xNSht = Nothing
　＞Set xNSht = Worksheets(CStr(xCol.Item(I)))
　＞If xNSht Is Nothing Then
で行っているようですが、シートが存在しない場合にはエラーが発生しませんか？
（ですので、ちゃんとしたチェックにはなっていないような・・）