ここから本文です

あるフォルダ内にあるExcelファイル全てに同一のマクロを走らせたいのですが、この...

aji********さん

2011/4/515:53:47

あるフォルダ内にあるExcelファイル全てに同一のマクロを走らせたいのですが、この処理をvbaで行うことは可能でしょうか?

行いたい作業は、
ファイル内の全てのシートの先頭6行の削除

Sub 行を削除するマクロ()
Application.ScreenUpdating = False
Dim Sht As Worksheet
For Each Sht In Worksheets
Sht.Select
Rows("1:6").Delete Shift:=xlUp
Next Sht
Application.ScreenUpdating = True
End Sub

と、フォルダ内のシートの結合

Sub MergeSheets()
Dim intLoop As Integer
Application.ScreenUpdating = False
Worksheets.Add before:=Worksheets(1), Count:=1
For intLoop = 2 To Worksheets.Count
Worksheets(intLoop).Select
Range("A1").CurrentRegion.Select
If intLoop > 2 Then
Selection.Resize(Selection.Rows.Count - 1).Offset(1).Select
End If
Selection.Copy
Worksheets(1).Select
If intLoop = 2 Then
Range("A1").Select
Else
Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Offset(1).Select
End If
ActiveSheet.Paste
Next intLoop
Application.CutCopyMode = False
Worksheets.Select
Range("A1").Select
Worksheets(1).Select
Application.ScreenUpdating = True
MsgBox "「" & Worksheets(1).Name & "」に全ワークシートのデータをまとめました。"
End Sub

です。
よい方法があればぜひご回答宜しくお願い致します。

閲覧数:
383
回答数:
1
お礼:
250枚

違反報告

ベストアンサーに選ばれた回答

hig********さん

2011/4/517:32:56

ajikansenpaiさん

処理したいフォルダに一度保存してから実行してください

Sub test()
Dim fName
fName = Dir(ThisWorkbook.Path & "\*.xls")
Do Until fName = ""
If ThisWorkbook.Name <> fName Then
Workbooks.Open ThisWorkbook.Path & "\" & fName
call 行を削除するマクロ
call MergeSheets
wb.Close True
End If
fName = Dir
Loop
End Sub

一度、testしてくださいね

参考まで

質問した人からのコメント

2011/4/6 10:29:58

ありがとうございます!

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる