エクセルファイルを一括で取得して順番にマクロを実行したい

質問

いろいろ考えたのですがわからないために質問させていただきます
ご指導宜しくお願いします。

Aというフォルダにある
book1
book2
book3
というエクセルファイルを一括に選択して自らに取り込んだ後
処理をして別フォルダに保存するという流れをしたいのですが
わかりません。
処理自体は不要列の削除と簡単なのですがファイルの数が多いため
一括でしたいのです。ご指導宜しくお願いします。

Sub test()
Dim OpenFileName As Variant
Dim wb As Workbook
ChDir CreateObject("WScript.Shell").SpecialFolders("desktop")
'ファイルを開く
OpenFileName = Application.GetOpenFilename("ExcelBook,*.xls,AccessDB,*.mdb")
'キャンセル
If OpenFileName = False Then
'終了
Exit Sub
End If
'このブックのSheet1をクリア
ThisWorkbook.Sheets("Sheet1").Cells.Clear
'ワークブックを開く
Set wb = Workbooks.Open(OpenFileName)
'選択されたブックの最初に表示するシートをコピー
wb.ActiveSheet.Cells.Copy Destination:=ThisWorkbook.Sheets("Sheet1").Cells(1, 1)
'閉じる
wb.Close False
'画面固定
Application.ScreenUpdating = False
'不要列選択
Range("A:A,C:C,E:E,G:G,I:I,K:K,M:M,O:O").Select
'選択列を削除
Selection.Delete Shift:=xlToLeft
Range("a1").Select
Dim ws As Worksheet
'元々開いていたシートを退避
Set ws = ActiveSheet
'全てのワークシートを新しいブックにコピー
Worksheets.Copy
'名前を自分で入れる場合
Application.Dialogs(xlDialogSaveAs).Show
ActiveWorkbook.Close False '新しいブックを閉じる
ws.Activate '元々開いていたシートを表示

現状はこのような感じで一つ一つ処理しています。

回答No.6

xls88 · ベストアンサー

サンプルです。
同名のファイルが既に存在する場合の処理とか考慮していません。
取りあえず、i の値を付けるようにしてあります。

Dim wb As Workbook
Dim opnFile As Variant
Dim filFilter As String
Dim i As Integer

filFilter = "Excel Files ,*.xl*"
opnFile = Application.GetOpenFileName(FileFilter:=filFilter, MultiSelect:=True)
If IsArray(opnFile) Then
　　For i = 1 To UBound(opnFile)
　　　　Set wb = Workbooks.Open(opnFile(i))
　　　　wb.Sheets("Sheet1").Cells.Copy _
　　　　　　Destination:=ThisWorkbook.Sheets("Sheet1").Range("A1")
　　　　wb.Close False
　　　　ThisWorkbook.Sheets("sheet1").Copy
　　　　ActiveWorkbook.Close _
　　　　　　savechanges:=True, FileName:=ActiveSheet.Name & i & ".xls"
　　　　ThisWorkbook.Sheets("sheet1").Cells.ClearContents
　　Next
End If

お礼

お礼が遅くなりました。
ありがとうございます。
これを元に作って行きたいと思います。

とても勉強になりました。

回答No.5

xls88

＞回答番号：No.4 この回答へのお礼
> こんな感じで取り込んだあとシート別にブックにして保存でいいのですが
> エクセルファイルの取り込み方がわからなくて悩んでおります。
”エクセルファイルの取り込み方”の意味が理解できません。
どういう状態、意味のにでしょうか？

シートを別ブックに保存の件は
シートラベルを右クリック＞「移動またはコピー」＞「移動先」を新しいブック＞「名前を付けて保存」
といった操作を「マクロの記録」すればどうでしょうか。

しかし、これだけのコードが書けるレベルの方が、悩まれることが不思議です。

お礼

シートを別ブックに保存は悩んだ結果
Sub test()
Dim ShtCnt As Integer, i As Integer
ShtCnt = ActiveWorkbook.Worksheets.Count
i = 1
ChDir ("C:\TEST\")
Do
Sheets(i).Activate
Sheets(i).Copy
ActiveWorkbook.Close savechanges:=True _
, Filename:=ActiveSheet.Name & ".xls"
i = i + 1
Loop Until i > ShtCnt
End Sub
こうなりました。

回答No.4

xls88

> Book0というマクロを含んだエクセルで
> Aというフォルダにある
> Book1のSheet1を
> Book3のSheet1に表示させたいのです。
表示＝Copyということですね。
ということなら、ブック名、シート名を明記しなければなりません。
複数のブック、シートを操作する場合、
それらを省略した記述にすると、ActiveWorkBook、ActiveSheetを指定したことになり、
間違ってコピーされたり削除される現象が起こります。

> 'このブックのSheet1をクリア
> ThisWorkbook.Sheets("Sheet1").Cells.Clear
> 'ワークブックを開く
> Set wb = Workbooks.Open(OpenFileName)
> '選択されたブックの最初に表示するシートをコピー
> wb.ActiveSheet.Cells.Copy Destination:=ThisWorkbook.Sheets("Sheet1").Cells(1, 1)
で、ThisWorkbookは、実行したマクロがあるBook0ということになります。
Book3にコピーするなら
Workbooks("Book3.xls").Sheets("Sheet1").Cells.Clear
Set wb = Workbooks.Open(OpenFileName)
wb.Sheets("Sheet1").Cells.Copy Destination:=Workbooks("Book3.xls").Sheets("Sheet1").Cells(1, 1)
と、明記しなければいけません。

次のブックは、Book3のどこにコピーするのですか？
このままでは上書きと同じことになり、前のブックのデータが消滅しそうです。

お礼

失礼しました
このBook3はBook0の間違いです。
つまりは特定のフォルダにあるエクセルファイルを一度
マクロを実行する本体に取り込みたいということなのです。
雰囲気としては
Sub ReadTextFiles()
Const DirName = "C:\TEMP"
'上記で指定されたフォルダに存在するファイルで、
'拡張子がtxtのものをすべて１シートとして読み込む

Dim fs, dir, fc, f1, stream As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set dir = fs.GetFolder(DirName)
Set fc = dir.Files
For Each f1 In fc
If LCase(fs.GetExtensionName(f1.Name)) = "txt" Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
Sheets(Worksheets.Count).Name = f1.Name
Set stream = f1.OpenAsTextStream
Do While stream.AtEndOfStream <> True
Cells(stream.Line, 1) = stream.ReadLine
Loop
stream.Close
End If
Next
End Sub
こんな感じで取り込んだあとシート別にブックにして保存でいいのですが
エクセルファイルの取り込み方がわからなくて悩んでおります。

回答No.3

n-jun

＃１です。

任意に複数のファイルを選択したいのか、勝手にフォルダ内のファイルに対して
自動で切り替えて実行したいのか。。。後者と解釈しました。

参考ＵＲＬはフォルダ内の「ファイル名」の取得ですが、「ファイル名」が取得できれば
ファイルを順次開く事になりますけど、そう言う意味ではなかったようですね。

回答No.2

xls88

GetOpenFileNameメソッドのMultiSelectオプションをTrueにすれば複数のFileを選択できます。

Sub test1()
　　Dim opnFile As Variant
　　Dim fFilter As String
　　Dim i As Integer

　　ChDir CreateObject("WScript.Shell").SpecialFolders("desktop")
　　fFilter = "Excel Files ,*.xl*,AccessDB ,*.mdb"
　　opnFile = Application.GetOpenFileName(FileFilter:=fFilter, MultiSelect:=True)
　　If IsArray(opnFile) Then
　　　　For i = 1 To UBound(opnFile)
　　　　　　MsgBox opnFile(i)
　　　　Next
　　End If
End Sub

回答No.1

n-jun

フォルダ内のファイル名を取得する
http://www.moug.net/tech/exvba/0060001.htm

ご参考の一例として。

お礼

回答ありがとうございます。
しかしファイル「名」を取得したいのではなくて
選択したブックそのものを取り込みたいのです。
具体的にいうと
Book0というマクロを含んだエクセルで
Aというフォルダにある
Book1のSheet1を
Book3のSheet1に表示させたいのです。