コピーしたデータを表中で収まるように２列に分けて貼り付けする方法を教えてください。

画像のように、B列に書かれたデータをコピーし、D3：E６の表に収まるように
２列に分けて張り付ける方法はありませんか？

B列に入力されているデータの最終行は変化することを前提にしていただきたいです。

a = Range("B2", Range("B").End(xlDown))
a.Copy
Range("D4").PasteSpecial Paste:=xlPasteValues

現状では上記のコードでコピペしています。

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

• 回答していただき、ありがとうございます。
  表のサイズに合わせてコピぺすることができるんですね。
  
  データはオートフィルタで抽出するので、その都度変わります。
  出力先範囲は２３行です。
  
  VBAの理解度についてはほとんど初心者と変わりません。
  関数を一つ一つ調べながら、勉強をしております。
  
  お手数をおかけしますが、宜しくお願いいたします。

  No.1の回答に寄せられた補足コメントです。 補足日時：2022/06/24 14:55

• お忙しい中、回答していただきありがとうございます。
  申し訳ございませんが、まだ未熟者ですので仰っていることが理解できません。
  
  余談の件は前にもお伝えしましたが、それはあなたの考え方であり他人に押し付けるものではありません。このサイトをどう使うのが正しいのか決めるのはあなたではなく、運営会社です。
  
  また、折角回答をしてくださる方の人格を否定するような発言は控えていただけませんか？
  自分の考え方や価値観が世の中の基準だと思い込むのは、やめたほうがいいですよ。
  人にはそれぞれの考え方や価値観があります。それを尊重し理解し合うよう努力するのが社会です。
  あなたのような人が匿名性を良いことに、インターネットで人を誹謗中傷するんですね。

  No.3の回答に寄せられた補足コメントです。 補足日時：2022/06/24 15:12

• その通りです。
  オートフィルタを一列にかけて、該当したデータが２３行以上の場合は２列に分けたいんです。
  いい方法はありますか？

  No.5の回答に寄せられた補足コメントです。 補足日時：2022/06/24 15:42

• 申し訳ございません。
  コピーするデータは３列あります。

  No.6の回答に寄せられた補足コメントです。 補足日時：2022/06/24 16:27

No.8 ベストアンサー 回答者： Qchan1962 回答日時： 2022/06/24 18:07

＃１です

＃５～7様が回答されていますが
＞データはオートフィルタで抽出するので、その都度変わります。
これは、重要な事柄です
フィルターはデータを絞り込んでいますが、データ数が変わったわけではありません
この場合、見えているセルが対象になり
.SpecialCells(xlCellTypeVisible)　などで取得します

参考：http://officetanaka.net/excel/vba/tips/tips155d. …
https://www.excel-chunchun.com/entry/20200613-ex …

見えているセルの個数23（行）個をコピー　D4セルに貼り付け
24個以降　最後（23刻み？）までをコピーE4に貼り付けなどで良いかも
2行からなので23個では無いか？・・・
記録などで上記参考サイトを参考にアレンジも出来るかも

コードが読めてデバッグが出来るのなら
ご質問に日本語で説明するより、コードで説明する方が簡単です
だって、カテゴリーVisual Basic（VBA）なので
むしろ日本語率もっと低くて良くない？なんて思うくらいですね
例えば、
a = Range("B2", Range("B").End(xlDown))　これはエラーが返ると思いますし
set a=　でないので　a.Copy　これもエラー
唯一　Range("D4").PasteSpecial Paste:=xlPasteValues　
D4セルを基軸に値貼り付けしたい　が分かります。
初めから間違っているので、ほとんど初心者な事は分かります
しかし、
＞関数を一つ一つ調べながら、勉強をしております。
これはとても大事な事です
サンプルコードを書いても鵜呑みにすることは無いかと思います（願います）

Sub Example()　'順番に書き込む一例（コピーでない
Dim outRng As Range, inRng As Range
Dim r As Range
Dim i As Long: i = 1
Dim j As Long: j = 1
Set outRng = Range("D4:E6") '出力範囲
Set inRng = Range("B2", Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible)
For Each r In inRng
outRng(i, j) = r.Value
If i < outRng.Rows.Count Then
i = i + 1
Else
i = 1
j = j + 1
End If
Next
End Sub
出力範囲に非表示行が重なるとデータを表示できない
（フィルタ解除で表示される・・）

私の思いは、＃３様が挙げる心情には該当はしませんけれど
確かに　自分で考えることを放棄する習慣がついてしまう方は少なからずおられます。
必ず検証して理解を深める事に努めれば良いのですが・・不幸な事です

もっとも、回答に実行数式、サンプル関数、実行プロシージャ、
サンプルコード、例などを書いてはならないと言う規約は無かったかと思います
表組、条件書式、関数はずばりの回答が多いけれど・・・
指名してやり取りをするのは、ダメです

余談ですが
私は独学で此れと言って教えてくれた方も存在しませんでした
そもそもプログラムや処理をするような職になったことはなく趣味の範疇です
独学の経験で記すと　質問サイトは学習する場としては向かないと思います

35年間で1度質問をしたことがありますが、結果自己解決でしたし、
（他のスレッドを見て）回答を待つのも、あーだこーだ言われるのも性に合いませんでした。
何より現在のスキルを明確に示す事が出来ないので回答者もいい加減な回答する人も少なくない時代でしたしね（私もいい加減ですが）

（情報の偏りは否めないかも知れませんが）
実際にリファレンスサイトなどで情報を集め実験、検証した方がデバッグ作業のスキルも身に付きますし、検索スキルも付きます。
初めは少々時間が必要かもしれませんがその方が良いと思います。。

カテゴリーVisual Basic（VBA）でこんな回答をするなんて・・
ともあれ、参考になれば幸いです

この回答へのお礼

ありごうごうざいます。
setが抜けていましたね。失礼いたしました。
お察しの通り初心者でございます。

回答して頂いたコードを元に勉強をさせていただきます。
ありがとうございました。

独学で勉強されるのはとても素晴らしいですね。
自分もできる範囲で検索しながら独学で勉強をしておりますが、また行き詰まった際にはご助力いただければ幸いです。

お礼日時：2022/06/27 16:07

No.7 回答者： めぐみん_ 回答日時： 2022/06/24 16:34

No.6です。

データ範囲とフィルタをかける位置（列名）と希望する結果を、先の画像のように添付するとわかりやすいかも。
⇒各列幅を少し狭めると綺麗に表示されないかな。

No.6 回答者： めぐみん_ 回答日時： 2022/06/24 15:55

No.5です。

では元データ（フィルタ前）は１列しかないのですか？

No.5 回答者： めぐみん_ 回答日時： 2022/06/24 15:34

ちょっとした疑問ですので違ってたらスル～されて構いませんので。

オートフィルタを１列にかけて該当したデータを２列にコピペするように思えるのですが、実際はそうなのでしょうか？
ちょっと過去の質問を思い出したのですが、元のデータは複数列あってある列にフィルタをかけヒットしたデータを別の個所に貼り付ける。
ただし行数の制限の為、行数は制限ありの複数列×２で行ないたいってのがむか～しあったので、まさかそんな感じの事ではないよね？と気になっただけです。

No.4 回答者： 銀鱗 回答日時： 2022/06/24 15:24

＞このサイトをどう使うのが正しいのか決めるのはあなたではなく、運営会社です。

(´・ω・`)……ここは作業依頼する場所じゃないんだ。マジで。運営もそう言ってる。
利用規約と投稿ガイドラインをよく読んでみましょう。

No.3 回答者： 銀鱗 回答日時： 2022/06/24 14:52

縦方向に何セルずつに分ければよいか、計算できますか？

できるのであれば、その計算を元に考えてみましょう。

本当は縦に並んだデータを横数列に分けて並べたいのだろうと推測してみました。

まあ、この考え方できれば、あとは For Next で何とでもなります。

・・・

どの段階で躓いているのかを示すと具体的な解決方法のアドバイスを貰えますよ。
例：
　「データが入力されている最終行を取得できません」


・・・余談・・・

質問者さん的には
　「そんな御託は良いから汎用性のあるテンプレートになるコードを見せろ」
……ってことなんでしょうけど、
残念ですが、ここは「代わりに作れ」と作業依頼する場所ではなく、
自身で問題を解決できるようになるためのアドバイスを貰う場所なんです。

それでも代わりに作ってくれたり、答えを教えてくれる人はいますが、
そんな人は
　「オレ様はこんなの余裕でできるんだぜｗｗｗ」
という思い上がりか、
　「ベストアンサー貰えるならなんだってするぜ！」
という欲深い奴か、
　「自分で考えることを放棄する習慣をつけさせちゃえｗｗｗ」
という意地悪な奴か、
……でしょう。

No.2 回答者： fujillin 回答日時： 2022/06/24 14:46

こんにちは

半分に分けて、転記すれば良いのではないでしょうか？

r = Int((Cells(Rows.Count, 2).End(xlUp).Row - 1) / 2)
If r > 0 Then
Cells(4, 4).Resize(r).Value = Cells(3, 2).Resize(r).Value
Cells(4, 5).Resize(r).Value = Cells(3, 2).Offset(r).Resize(r).Value
End If

No.1 回答者： Qchan1962 回答日時： 2022/06/24 14:45

こんにちは

一気にコピーでは出来ないかと
貼り付け先の範囲に合わせて　.Rows.Count　.Columns.Countで取得
サイズに合わせてコピぺ
xlPasteValues　書式設定が不要の場合（値のみ）は
取得、出力すれば良いと思います

コードが欲しい場合は、出力先範囲を超える場合の定義が必要です
VBAの理解度やデーター数量なども欲しい所です・・
（配列を作って出力する方が早いけれど、判り難いかもなので）