エクセルで繰り返し同じ作業をしたい

質問

仕事でDドライブの中のフォルダにエクセルのシートが１００種類位入っています。それらのエクセルシートに毎日同じ作業をしなければならないのですが、（エクセルを開いて行う作業は各シート共通です）そのマクロの作り方を教えていただけないでしょうか？ちなみに
Workbooks.Open Filename:="D:\業務\あ.xls"
Range("D9").Select
Selection.Copy
Range("E9").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
Workbooks.Open Filename:="D:\業務\い.xls"
Range("D9").Select
Selection.Copy
Range("E9").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
Workbooks.Open Filename:="D:\業務\う.xls"
Range("D9").Select
Selection.Copy
Range("E9").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close

　　その後もまだまだ続きます。

というマクロの記録を使って作ってはいるものの、やたらと長くなってしまいます。VBAの知識がない初心者なのですが、いい方法があれば教えていただけないでしょうか？

回答No.4

ForestRain

File System Objectを使った方法です。

Sub Test()
Dim myFolder As String
Dim f As Object
Dim wb As Workbook
Dim FSO As Object
Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")
myFolder = ThisWorkbook.Path
For Each f In FSO.GetFolder(myFolder).Files
If FSO.GetExtensionName(f) = "xls" _
And f.Name <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(myFolder & "\" & f.Name)
With wb
.Sheets("Sheet1").Range("D9").Copy Sheets(1).Range("E9")
.Save
.Close
End With
End If
Next
Application.ScreenUpdating = True
Set wb = Nothing
Set FSO = Nothing
End Sub

このマクロを新規ブックの標準モジュールに記述して
D:\業務フォルダに放り込んで実行します。
各ブックの対象シートが明示されていなかったので
Sheet1としてありますが、実状に合わせて変更してください。

お礼

ずいぶんお礼が遅くなって申し訳ありませんでした。操作に不慣れなもので・・・。参考にさせていただきます。ありがとうございました。

回答No.3

imogasi

ファイル名をどこかへ覚えさせて、順々に変化させて繰り返せばよい。その記録させる場所だが、配列も良いが、せっかくエクセルVBAで
シートのセルと言う便利なものがあるので
あるシートのA1以下にファイル名を入力し記録する。
あ.xls
い.xls
う.xls
・・・
下記を標準モジュールに貼り付け、パス名を実際のものに修正する。
そして実行する。
Sub test01()
Dim sh1 As Worksheet
Set sh1 = Worksheets("Sheet1")
d = sh1.Range("A65536").End(xlUp).Row
' MsgBox d
For i = 1 To d
Workbooks.Open Filename:="C:\Documents and Settings\XXXX\My Documents\" & sh1.Cells(i, "A")
Range("D9").Select
MsgBox Range("D9")
Selection.Copy
Range("E9").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
Next i
End Sub
上記はあ。ｘｌｓなどのSheet1のD9セルを、同じブックのShhet1のE9セルにコピー貼り付けしているだけです。
あまり実際二ーズが考えられない例だが。
Application.ScreenUpdating = False を最初に
Application.ScreenUpdating = True　を最後に入れたほうが良いでしょう。
一応３ブックでテスト済み。

お礼

ずいぶんお礼が遅くなって申し訳ありませんでした。操作に不慣れなもので・・・。参考にさせていただきます。ありがとうございました。

回答No.2

merlionXX

Dドライブの業務フォルダーにはいっている、自分自身（このマクロを書くファイル）以外の全てのエクセルファイルのアクティブになったシートに対して実行する方法です。

Sub test()
Application.ScreenUpdating = False '画面更新を一時停止
fname = Dir("D:\業務\*.xls") 'フォルダ内のExcelファイルを検索
Do Until fname = Empty '全て検索し終えると、fname = Empty となるので、その間以下を実行
If fname <> ThisWorkbook.Name Then 'ファイル名がこのファイルじゃなければ
Workbooks.Open "D:\業務\" & fname '選択したファイルを開く
Range("D9").Copy
Range("E9").PasteSpecial
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close
n = n + 1
End If
fname = Dir '選択したフォルダ内の次のExcelファイルを検索します
Loop '繰り返す
Application.ScreenUpdating = True '画面更新一時停止を解除
MsgBox n & "件の作業を終了しました。"
End Sub

元データのバックアップを必ずとってから実行してみて下さい。

お礼

ずいぶんお礼が遅くなってすいませんでした。なにぶん始めての質問だったもので申し訳ありません。参考にさせていただきます。ありがとうございました

回答No.1

molly1978

VBAを使うしかないと思います。例えば、
1.新しいワークシートに、[表示]－[ツールバー]－[コントロールツールボックス]を開き、コマンドボタンを置く
2.コマンドボタンをダブルクリックして、VBAを開き、コードを記述する。

Private Sub CommandButton1_Click()
Dim f(100) As String
f(1) = "D:\業務\あ.xls"
f(2) = "D:\業務\い.xls"
f(3) = "D:\業務\う.xls"
…＜同様の記述＞

i = 1
Do
Subcopy (f(i))
i = i + 1
Loop While i < 100
End Sub

Private Sub Subcopy(file)
Workbooks.Open Filename:=file
Worksheets("Sheet1").Range("D9").Select
Selection.Copy
Worksheets("Sheet1").Range("E9").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
End Sub

3.エクセルファイルを名前を付けて保存する。
4.エクセルファイルを開き、ワークシート上のボタンを押してマクロを実行する。

こんな流れですが、業務ファイルを破壊する恐れがありますので、
☆VBAに慣れた人に相談する
☆作動を十分に確認する
☆元データのバックアップを必ずとる
を行ってから実行して下さい。

お礼

丁寧にお答えいただきまして本当にありがとうございます。早速バックアップを取った後に教えていただいたコードで試して見たいと思います。ありがとうございました。