横1行のデータを3つずつ3列に変換したい（マクロ初心者）

エクセルのマクロ初心者です。
大変困っています。
よろしくお願いします（図も同封します）。

元データについて：【元データ】は、1行目は、B1からデータのヘッダー
　　　　　　　　　　　　　　　　　2行目は、A1にデレクトリーの最後にファイル名.csv
　　　　　　　　　　　　　　　　　　　　　　B2以降にデータ（426個）があります。

お願い：マクロで行いたいこと
　１）【元データ】2行目のB2,C2,D2の３データを→新しいファイルのシートの1行目に
　　　【元データ】2行目のE2,F２,G2の3データを→新しいファイルのシートの2行目に
　　　と・・・横1行のデータを、3個セットの列に変換したいのです。
また、
　２）新しいファイルは、2行目のA1にあるファイル名（たとえばtest100.xls）で保存したい。

というものです。
　
　
さらに、もし可能でしたら
　３）【元データ】は、2行目から始まり110行ほど連続してあり、１）と２）の作業を
　　　2行目を行ったら3行目と順に行い、結果としてA列のファイル名をそれぞれ使った、
　　　109個のファイルを作成したい。

　になります。
　１）２）だけでも作業の効率化がはかれ、大変助かります。
　是非お力添えをよろしくお願いします。

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

• fujillinさま
  早速ありがとうございます。
  
  慌てており、記載ミスや説明不足で混乱させてしまいすみません。
  
  ＞そもそもA1は2行目ではないけれど、それば別としても、なんで内容が変わっているのだろうか？
  ＞A列には、（保存したい）ファイル名が順に並んでいるという事なのだろうか？
  ＞（A1セルだけではなく、A列に並んでいる？）
  
  A1ではなくA2が正解です。A列（A１は空欄）に保存したいファイル名が並んでいます。
  
  ＞添付図では、X10以降もデータがあるようだが、X1～X9の9個のデータを3×3に並べ替えたものを1＞つのファイルにしたいという事でしょうか？
  
  データーはX10以降もあり426個（X426）まであり、すべて使用します。
  
  ＞109個のファイルになるには、最低で109×9＝981セル分のデータが必要ですが
  
  426セル×109列＝46,434セルあります。

  No.1の回答に寄せられた補足コメントです。 補足日時：2021/12/17 15:56

• tatsumaru77さん
  
  ＞画像をみるとtest100.csvのように見えます。
  ＞又、test100.xlsxではなくtest100.xlsですか。
  ＞本当のところは、拡張子はcsv,xls,xlsxのどれなのでしょうか。
  
  　失礼しました。
  　.xlsxになります。
  　よろしくお願いします。

  No.2の回答に寄せられた補足コメントです。 補足日時：2021/12/17 18:00

No.3 ベストアンサー 回答者： tatsumaru77 回答日時： 2021/12/17 18:04

ファイルの拡張子はxlsxであることが前提です。

元データのシート名は「元データ」としてあります。あなたの環境にあわせて適切に設定してください。

Option Explicit
Public Sub 複数列まとめ()
Dim ws As Worksheet
Dim newbk As Workbook
Dim newsh As Worksheet
Set ws = Worksheets("元データ")
Dim colno As Long
Dim col1 As Long
Dim rowno As Long
Dim row1 As Long
Dim row2 As Long
Dim seq As Long
For rowno = 1 To 109
Set newbk = Workbooks.Add
Set newsh = newbk.Worksheets(1)
row1 = rowno + 1
For seq = 1 To 142
row2 = seq
newsh.Cells(row2, 1).Value = ws.Cells(row1, (seq - 1) * 3 + 2).Value
newsh.Cells(row2, 2).Value = ws.Cells(row1, (seq - 1) * 3 + 3).Value
newsh.Cells(row2, 3).Value = ws.Cells(row1, (seq - 1) * 3 + 4).Value
Next
newbk.SaveAs (ws.Cells(row1, 1).Value)
newbk.Close
Next

End Sub

この回答へのお礼

tatsumaru77さん

142セルを希望通り3例に配置でき、ファイル名も付けられました。
ありがとうございました。

その後、426セルに対応するように変更し、
109ファイルすべて無事作業ができました。
感謝いたします。

相談側の私の誤記等により、お手数をおかけしました。

今後ともよろしくお願いします。
本当にありがとうございました。

お礼日時：2021/12/17 20:56

No.4 回答者： Qchan1962 回答日時： 2021/12/17 18:32

こんばんは、

なさりたい事は良く分かりませんが、ファイルが沢山出来ても良いのかな？
データの加工か何か？
方法考え直した方が良いような気がします。
＞たとえばtest100.xlsx　　Excelで吐き出すのは、ちょっと、、

私だったらで考えると、
各CSVを一つのCSVに纏めて、（すでにありますね（元データ））
必要個所を使用する時に抽出するような処理の方を考えるかな。。

すでにコードが示されていますが、、一応
実行内容
必要なデータ（1行）をファイルに抽出作成する場合

こんな感じ
＊コード内の必須条件
①元データシート　　名前：元データ
②抽出用シート　　　名前：抽出データ
③A列には拡張子を含むフルパスが書いてある　ファイルに名前を付ける為
　ご質問文の通り（存在しなくても良い）
④デスクトップに保存用フォルタをあらかじめ作成しておく
　フォルダ名（大文字）：TEST

実行要件
加工したい行の1セルを選択し　VBAを実行
（実行はボタンやショートカットキーなどからsampleを実行）

スクリーン更新抑止などは加えてください。
簡単なエラー処理を入れましたが、同名ファイルなどの保存時はアラートが出ます。
抽出用シートに抽出データが残るようにしています。

Sub sample()
Dim i As Long, j As Long, ii As Long, n As Long
Dim buf As Variant, Ary()
Dim r As Range
Dim folPath As String, nBkName As String

folPath = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\TEST\"
With Worksheets("元データ")
ii = Selection.Row
Set r = .Cells(ii, 1)
On Error Resume Next
nBkName = Left(Mid(r.Text, InStrRev(r.Text, "\") + 1), InStr(Mid(r.Text, InStrRev(r.Text, "\") + 1), ".") - 1)
If Err.Number <> 0 Then Exit Sub

If .Cells(ii, 1) <> "" Then
buf = .Range(.Cells(ii, 2), .Cells(ii, Columns.Count).End(xlToLeft))
ReDim Ary(Application.WorksheetFunction.RoundUp(UBound(buf, 2), 0) / 3, 3)
n = 0
For i = 1 To UBound(buf, 2) Step 3
For j = 0 To 2
On Error Resume Next
Ary(n, j) = buf(1, i + j)
Next
n = n + 1
Next
Worksheets("抽出データ").Range("A:C").ClearContents
Worksheets("抽出データ").Range("A1").Resize(UBound(Ary), 3) = Ary
Worksheets("抽出データ").Copy
ActiveWorkbook.SaveAs folPath & nBkName & ".xlsx"
ActiveWorkbook.Close
Erase buf, Ary
Set r = Nothing
End If
End With
End Sub

すべてを出力するコードも書きましたが、、、やめておいた方が良いと思います。
使用するにしても、もう少しVBAを分かってからの方が良いと思いますので

この回答へのお礼

Qchan1962さん

　ありがとうございます。
　ファイルはたくさん出来て構いません。
　おっしゃる通り、データの加工です。
　この形式で、市販のソフトに読み込みます。

＞必要個所を使用する時に抽出するような処理の方を考えるかな。。

　おっしゃるように、それがスマートなのですが、
　市販のソフトがそのような読み込み方をしないのです。
　残念ながら１つ１つファイルを作成する必要があります。

＞すでにコードが示されていますが、、一応

　いえ、ありがとうございます。
　感謝いたします。

＞スクリーン更新抑止などは加えてください。

　はい。

　Qchan1962さんのプログラムでも動作確認しました。
　目的の結果が得られました。
　ありがとうございました。
　
　勇気をもって相談させていただいて、
　本当に良かったです。
　
　今後ともよろしくお願いします。

お礼日時：2021/12/17 21:12

No.2 回答者： tatsumaru77 回答日時： 2021/12/17 17:51

補足要求です。

>新しいファイルは、2行目のA1にあるファイル名（たとえばtest100.xls）で保存したい。

画像をみるとtest100.csvのように見えます。
又、test100.xlsxではなくtest100.xlsですか。
本当のところは、拡張子はcsv,xls,xlsxのどれなのでしょうか。
それによってマクロの処理内容もかわってきます。
すなおにxlsxで書き込む場合は問題ありませんが、xlsで書き込むと、そのファイルを読み込み時、警告がでます。
csvで書き込む場合は、テキストファイルとして保存するので、また違った処理が必要となります。

No.1 回答者： fujillin 回答日時： 2021/12/17 15:26

こんにちは

残念ながら回答ではありません。

ご質問内容は、可能であろうとは思いますが、なさりたいことがよくわかりません。

＞2行目は、A1にデレクトリーの最後にファイル名.csv
＞新しいファイルは、2行目のA1にあるファイル名（たとえばtest100.xls）で保存したい。
そもそもA1は2行目ではないけれど、それば別としても、なんで内容が変わっているのだろうか？
A列には、（保存したい）ファイル名が順に並んでいるという事なのだろうか？
（A1セルだけではなく、A列に並んでいる？）

＞横1行のデータを、3個セットの列に変換したいのです。
添付図では、X10以降もデータがあるようだが、X1～X9の9個のデータを3×3に並べ替えたものを1つのファイルにしたいという事でしょうか？
（X10より右側のデータは使わないという事か？）

＞109個のファイルを作成したい。
109個のファイルになるには、最低で109×9＝981セル分のデータが必要ですが
＞B2以降にデータ（426個）があります。
426個のデータからどのようにして981個のデータを作るのかが不明です。
（使わないデータもあるようなので、もっと多くのデータが必要なはず‥）

※ ファイルを109個も作成してしまうと、扱いにくくてしょうがないのではないかという懸念もありますけれど。

この回答へのお礼

fujillinさん

　私の相談の文中の誤記や、
　わかりやすく伝えるために使用した図が
　イメージずぎてやりたいことが伝わっておらず・・・。

　そこをfujillinさんの質問にお答えすることで、
　とてもスムーズに回答をいただけ、解決できました。
　本当にありがとうございました。

　また、よろしくお願いします。

お礼日時：2021/12/17 21:21