excel マクロについて

excel　でマクロを使って以下のようなプログラムを組みたいです。

同じフォーマットのファイルが数十個あり、その中の一つの列を別の新しいファイルαにまとめたいです。
例えば、ファイルA~Gがあるとして、ファイルAのC列をファイルαのA列、ファイルBのC列をファイルαのB列、ファイルCのC列をファイルαのC列、ファイルDのC列をファイルαのD列にといった感じです。

どなたかわかる方お願いいたします。

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

• マクロを記録したファイルとは別に、データのファイルがあるので、そのデータのファイルを開くという行為が記録されてないように感じるのですが、どうでしょうか。。。

  No.1の回答に寄せられた補足コメントです。 補足日時：2019/11/14 12:35

No.6 回答者： Gen_bamboo 回答日時： 2019/11/20 14:51

DIR関数が拾ってくる順になる感じのコードです。

＜以下コード＞
Sub maketestdata(count As Integer)
　　Dim newBookName As String
　　Dim newBookPath As String
　　Dim newBook As Workbook
　　Dim newSheet As Worksheet
　　Dim targetColumn As Integer
　　targetColumn = 3 'C列なら３
　　For i = 1 To count
　　　　newBookName = "test" + CStr(i) + ".xlsx"
　　　　newBookPath = ThisWorkbook.path & "\" & newBookName
　　　　If Dir(newBookPath) = "" Then
　　　　　　DrawOff
　　　　　　Application.StatusBar = "making " + newBookName
　　　　　　Set newBook = Workbooks.Add
　　　　　　Set newSheet = newBook.Worksheets(1)
　　　　　　With newSheet
　　　　　　　　For j = 1 To 10
　　　　　　　　　　.Cells(j, targetColumn) = i * 100 + j
　　　　　　　　Next
　　　　　　End With
　　　　　　newBook.SaveAs newBookPath
　　　　　　newBook.Close
　　　　　　DrawOn
　　　　　　Application.StatusBar = False
　　　　Else
　　　　　　'MsgBox "既に" & newBookName & "というファイルは存在します。"
　　　　End If
　　Next
End Sub
Sub main()
　　Dim newBookName As String
　　Dim newBookPath As String
　　Dim newBook As Workbook
　　Dim openBookName As String
　　Dim openBook As Workbook
　　Dim openSheet As Worksheet
　　Dim newSheet As Worksheet
　　Dim targetColumn As Integer
　　targetColumn = 3 'C列なら３
　　newBookName = "fusion.xlsx"
　　newBookPath = ThisWorkbook.path & "\" & newBookName
　　If Dir(newBookPath) = "" Then
　　　　DrawOff
　　　　Application.StatusBar = "making " + newBookName
　　　　Set newBook = Workbooks.Add
　　　　Set newSheet = newBook.Worksheets(1)
　　　　With newSheet
　　　　　　Dim openBookName As String
　　　　　　openBookName = Dir(ThisWorkbook.path & "\*.xlsx")
　　　　　　Dim counter As Integer
　　　　　　counter = 1
　　　　　　Do While file <> ""
　　　　　　　　Set openBook = Workbooks.Open(ThisWorkbook.path + "\" + openBookName)
　　　　　　　　Set openSheet = openBook.Worksheets(1)
　　　　　　　　For i = 1 To 10
　　　　　　　　　　.Cells(i, counter) = openSheet.Cells(1, targetColumn)
　　　　　　　　Next
　　　　　　　　counter = counter + 1
　　　　　　　　Workbooks(file).Close
　　　　　　　　file = Dir
　　　　　　Loop
　　　　End With
　　　　newBook.SaveAs newBookPath
　　　　DrawOn
　　　　Application.StatusBar = False
　　Else
　　　　'MsgBox "既に" & newBookName & "というファイルは存在します。"
　　End If
End Sub
Sub test()
　　maketestdata (10)
　　main
End Sub
Sub DrawOff()
　　　　　　Application.DisplayAlerts = False
　　　　　　Application.ScreenUpdating = False
End Sub
Sub DrawOn()
　　　　　　Application.DisplayAlerts = True
　　　　　　Application.ScreenUpdating = True
End Sub

No.5 回答者： GooUserラック 回答日時： 2019/11/16 10:44

No.2 に対する回答が有りませんが、もう解決されてしまったのでしょうか？

No.4 回答者： Qchan1962 回答日時： 2019/11/15 13:53

こんにちは、

要は、他のファイルの列をコピーし、纏めたいのだと理解しました。
ファイルの場所やシート名など不明なので、こちらから条件を出します。
纏めたいファイルを同じフォルダに入れてください。VBAの書かれたBookと同じでなくても良いです。

纏めるBookにVBAコードを書きます。
ご質問の場合は、ファイル名を配列に入れてソートし列をループ変数などで移動すれば良いですが、ファイル名は例なので
実際にソートで列のインデックスとの関係が保証されるか分かりません。また、4列目をまとめたいなど変更したい場合も
VBAを触る事になり、面倒なので、各条件を変更できるようにシートに出しましたので、条件設定のシートを新規に作成してください。
シート名は　condition　です。変更する場合は、VBAも変えてくださいね。
シートの内容は、画像を添付しますので、参考にしてください。
簡単な表の説明：
TargetFilesは、ファイル名です。下へ書き足してください。（数は問いません）
TargetColumnは、コピーしたいファイルの列№です。A列なら1、C列なら3です。
InColumnは、纏めるシートの列№です。
TargetSheetIndex:は、コピーしたいファイルのシートインデックスです。一番左にあるシートなら、1です。
InSheetIndex:は、纏めるシートのインデックスです。
Extension:は、ファイルの拡張子です。
設定したら、シートは非表示にしても良いです。

画像は、ご質問のファイルAのシートインデックス1のC列をThisWorkbookのシートインデックス1のA列にコピペします。以下続く

コードは以下に掲示します。
On Error Resume Next　は、使いたくないけれどエラールチン書くの面倒なのでごめんなさい。
ファイルが無いなどでエラーになるのを飛ばしますので、上手く動作しないときなどは、On Error Resume Nextをコメントに変えデバッグしてください。

突っ込みどころは、あるかも知れませんが、一例ですので悪しからず。

Option Explicit
Sub Sample()
Dim TargetFiles(), TargetColumn(), InColumn()
Dim wb As Workbook
Dim TargetSheetIndex As Long, InSheetIndex As Long
Dim MaxRow As Long, n As Long
Dim Folder_Path As String, Extension As String
On Error Resume Next
　　Worksheets("condition").Activate
　　With ActiveSheet
　　　　MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row
　　　　TargetFiles = .Range(Cells(2, 1), Cells(MaxRow, 1)).Value
　　　　TargetColumn = .Range(Cells(2, 2), Cells(MaxRow, 2)).Value
　　　　InColumn = .Range(Cells(2, 3), Cells(MaxRow, 3)).Value
　　　　TargetSheetIndex = .Cells(1, 6).Value
　　　　InSheetIndex = .Cells(2, 6).Value
　　　　Extension = .Cells(3, 6).Value
　　End With
　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　.InitialFileName = CreateObject("WScript.Shell").SpecialFolders("desktop")
　　　　If .Show = True Then
　　　　　　Folder_Path = .SelectedItems(1) & "\"
　　　　End If
　　End With
　　If Folder_Path = "" Then Exit Sub
　　Application.DisplayAlerts = False
　　Application.ScreenUpdating = False
　　For n = LBound(TargetFiles) To UBound(TargetFiles)
　　　　Set wb = Workbooks.Open(Folder_Path & TargetFiles(n, 1) & Extension)
　　　　wb.Worksheets(TargetSheetIndex).Columns(TargetColumn(n, 1)).Copy _
　　　　Destination:=ThisWorkbook.Sheets(InSheetIndex).Columns(InColumn(n, 1))
　　　　wb.Close savechanges:=False
　　Next n
　　Application.DisplayAlerts = True
　　Application.ScreenUpdating = True
End Sub

コードの説明は割愛しますので、必要であれば、返信ください。

No.3 回答者： fujillin 回答日時： 2019/11/14 12:58

こんにちは

＞どなたかわかる方お願いいたします。
コードを組むには、あまりにも漠然とした質問なので、なんとも回答のしようがありませんが、手順を記したところで（多分）何の役にも立たないと思われますので、無理やり・・・

こんな雰囲気で可能ではないでしょうか。
ファイルαがActiveSheet（ThisWorkbook）であると仮定しています。
まぁ、具体例を示したからといって、役に立つとは限りませんが…


Sub Sample()

Dim fName(), wb As Workbook
Dim destRange As Range, n As Long

Const targetSheet = 1　'コピー対象シート
Const targetColumn = 3　'コピー対象列

fName = Array("ファイルA.xls", "ファイルB.xls")　'対象ブックのパス
Set destRange = ActiveSheet.Columns(1)　'ファイルαと仮定

' 以下、順にコピー処理
For n = LBound(fName) To UBound(fName)
　Set wb = Workbooks.Open(fName(n))
　wb.Worksheets(targetSheet).Columns(targetColumn).Copy Destination:=destRange
　Set destRange = destRange.Offset(0, 1)
　wb.Close savechanges:=False
Next n

End Sub

No.2 回答者： GooUserラック 回答日時： 2019/11/14 12:50

一番めんどくさそうなのはどのファイルをどの列に置くか？の指定方法です。

今回のようにファイル名に列記号が入っているなら指定は不要ですけどね。
ファイルの位置指定はどのようにするつもりですか？
①ファイル選択で即時コピーを繰り返す。（重複コピーの可能性が高くなる）
②最初にコピーリストを作成し、それを基に一挙にコピーする。
③順番は関係なく同じフォルダに有る物を一挙にコピーする。
④その他（具体的に示してください）

No.1 回答者： 銀鱗 回答日時： 2019/11/14 12:01

とりあえず3つくらいのファイルに対して手動で操作を行う手順を「マクロの記録」でマクロにしてみましょう。

そこからどの項目を共通化、自動化できるかを考えれば良いと思います。