| |
▼はるな さん：
こんばんは
各ブックのシートを、別ブックにコピーするのか、あるブックのあるシートを各ブックにコピーするのか
要件が理解できていませんので、とりあえず、前者で。はずしている確率、８５％ぐらい？
勘違いしていたらすててください。
親ブックを作るとか、ボタンを配置するとか、それらは割愛しています。
指定フォルダの各エクセルブックのすべてのシートを１つのブックにまとめ まとめたブックを、
マクロブック名_作成.xls という名前で、マクロブックがあるフォルダに 保存します。
この間、各エクセルブックも、まとめたブックも表示されません。１００個もブックがあると時間はかかると思いますが。
それと、シートの数が膨大になりますのでメモリーの関係で、悪名高い（？）１００４のエラーが発生するかもしれません。
Sub Sample()
Dim myPath As String
Dim newWb As Workbook, workWB As Workbook
Dim fsoFile As Object
Dim sh As Worksheet
Dim Fso As Object
Dim xlApp As Excel.Application
myPath = "C:\Test" '<== 実際のフォルダ名に
Set xlApp = New Excel.Application
Set Fso = CreateObject("Scripting.FileSystemObject")
For Each fsoFile In Fso.GetFolder(myPath).Files
If LCase(Fso.GetExtensionName(fsoFile.Name)) = "xls" Then
Set workWB = xlApp.Workbooks.Open(Filename:=myPath & "\" & fsoFile.Name)
If newWb Is Nothing Then
Set newWb = workWB
Else
For Each sh In workWB.Worksheets
DoEvents
sh.Copy after:=newWb.Sheets(newWb.Worksheets.Count)
Next
workWB.Close savechanges:=False
End If
End If
Next
Application.DisplayAlerts = False
newWb.SaveAs ThisWorkbook.Path & "\" & ThisWorkbook.Name & "_作成.xls"
newWb.Close
Application.DisplayAlerts = True
xlApp.Quit
MsgBox "処理が終了しました"
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
