同じ場所にあるファイル全てに対してマクロをかけたい

質問

＜やりたいこと＞
マクロと同じフォルダに入っている全ファイル(そのときによりファイル数が変わる）に対し、
1、2行を削除し、オートフィルタを消し、A2にある「No.1」を「No1」(ドットを消す）にし、
ファイルを上書き保存するようにしたいです。

＜今の状態と質問＞
全ファイル(例は4つ）を開いた状態で下記のマクロをかければ、
希望の処理ができます。
が、複数ファイルが有る場合、ファイル全てを開いて実行するのは難ありです。
事前にファイルを開く手間をかけずに、マクロで全て処理する方法は
どうしたらいいのでしょうか。

過去検索で、Workbooks.Open Filename:= (ThisWorkbook.Path & "\*.xls")などを
見よう見真似で追加したりしてみたものの動きませんでした。

今の段階(4ファイル開いておけば実行可能）のマクロは下記の通りです。

Sub test()
'
' Keyboard Shortcut: Ctrl+q
'
Rows("1:2").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
Range("A1").Select
ActiveCell.FormulaR1C1 = "No1"
Range("A2").Select
ActiveWorkbook.Save
ActiveWindow.Close

Rows("1:2").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
Range("A1").Select
ActiveCell.FormulaR1C1 = "No1"
Range("A2").Select
ActiveWorkbook.Save
ActiveWindow.Close

Rows("1:2").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
Range("A1").Select
ActiveCell.FormulaR1C1 = "No1"
Range("A2").Select
ActiveWorkbook.Save
ActiveWindow.Close

Rows("1:2").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
Range("A1").Select
ActiveCell.FormulaR1C1 = "No1"
Range("A2").Select
ActiveWorkbook.Save
ActiveWindow.Close
End Sub

回答No.1

keithin · ベストアンサー

sub macro1()
　dim myPath as string
　dim myFile as string
　dim w as workbook
　dim s as worksheet

　mypath = thisworkbook.path & "\"
　myfile = dir(mypath & "*.xls")
　do until myfile = ""
　　if myfile <> thisworkbook.name then
　　　set w = workbooks.open(mypath & myfile)
　　　for each s in w.worksheets
　　　　s.autofiltermode = false
　　　　s.range("1:2").delete shift:=xlshiftup
　　　　s.range("A1") = "No1"
　　　next
　　　w.close savechanges:=true
　　end if
　　myfile = dir()
　loop
end sub

といった具合に。

お礼

何度もご丁寧にありがとうございました。
keithinさんにお答えいただけたらと思ってこちらに捕捉(継続）で質問をさせて
いただきましたが、ちょっと時間がなかったので新たに質問をたちあげさせて
いただきました。すいません。
本当にありがとうございます！

補足

できました！ありがとうございます。
ちなみに、ファイル名を変更して保存することは可能でしょうか。
処理前のファイル：AAA.xls
処理後のファイル：○AAA.xls
としたいです。

回答No.2

imogasi

Sub test02()
Application.ScreenUpdating = False
flg = Array("3.xls", "01ＸＸ.xls", "２日.xls", _
"２段リスト.xls", "bbb.xls")
For i = 0 To UBound(flg)
Workbooks.Open flg(i)
MsgBox flg(i)
Application.DisplayAlerts = False
ActiveWorkbook.Close
Next i
Application.ScreenUpdating = False
End Sub
を参考にして、MsgBox flg(i)のところに処理を入れてはどうだろう。
配列は２０ファイルぐらいまで課と思う。その良いところはＡｒｒａｙに記述順序で開かれる。
セルの１つの空き列に記述しても良い。
ーー
もうひとつ
Sub test01()
Set objfs = CreateObject("scripting.filesystemobject")
d = CurDir()
MsgBox d
flg = Array("3.xls", "01化.xls", "２日.xls", _
"２段リスト.xls", "bbb.xls")
Set fld = objfs.getfolder(d)
For Each fl In fld.Files
For i = 1 To UBound(flg)
If fl.Name = flg(i) Then
MsgBox fl.Name
End If
Next i
Next
End Sub
なども考えられる、かもしれないが、フォルダのすべてや、少数例外以外のファイルを処理するときは良いが、その存在を確認後やはりブックを開かないといけないのであまりメリットが無いかもしれない。
。
＞(4ファイル開いておけば
なぜ４つのブックを開いておく必要があるのか良くわからない（質問での説明不足）
１つづつ、開いて処理、閉じるのくり返しではないのですか。
＞オートフィルタを消し
突然出てきて何のことか判らない。
全般に、ポイントの押さえどころがあいまいで、まだＶＢＡの経験も少ない（マクロの記録程度？）のに、難しいことをやりすぎの感あり。
ーー
「マクロをかける」と言う表現はしない。
ーー
処理する内容が、質問文に時系列的に説明されていない。コードを載せるより、手作業でやるとした場合の処理順序を明確に説明する訓練をしたほうが、今後役立つ。

お礼

ありがとうございます。
素人で、説明が下手で申し訳ありませんでした。