[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『全シートに同じ内容の処理』(田中)
フォルダ内全ブック、全シートに対して値複写を行いたいと思っています
下記のものだと1シートにしか対応しません
どの様にすればよろしいでしょうか?
Sub Sample()
Dim buf As String
Dim fPass as String
fPass=Thisworkbook.pass & "\フォルダ名\"
buf = Dir(fPass & "*.xls")
Do While Len(buf) > 0
Workbooks.open Filename:=fPass & buf, UpdateLinks:=0
Worksheets("Sheet1").Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Workbooks(buf).save
Workbooks(buf).close
buf = Dir()
Loop
End Sub
< 使用 Excel:Excel2010、使用 OS:Windows10 >
この辺りとか、 https://search.yahoo.co.jp/search?p=%E3%83%9E%E3%82%AF%E3%83%AD+%E5%85%A8%E3%81%A6%E3%81%AE%E3%82%B7%E3%83%BC%E3%83%88%E3%81%AB%E9%81%A9%E7%94%A8&fr=top_ga1_sa&ei=UTF-8&ts=16521&aq=0&oq=%E3%83%9E%E3%82%AF%E3%83%AD%E3%80%80%E3%81%99%E3%81%B9%E3%81%A6%E3%81%AE%E3%81%97&at=s&ai=w6hdXBbZTbq6CfKw0A8vaA (BJ) 2020/05/11(月) 15:17
開いたブックに対してシートを一つずつFor Each 〜 Nextで取り出して処理します。 全体をコピーして値で貼り付けるよりも各セルの値だけ代入した方が速いかと思いますので Sh.UsedRange.Value = Sh.UsedRange.Value で使われているセル範囲の値のみ代入しなおしています。
ついでにApplication.ScreenUpdatingで画面の表示を止めて、ブックを開閉によるちらつきを なくしています。Application.DisplayAlertsで保存時の注意メッセージを止めています。
Sub Sample2() Dim buf As String Dim fPass As String Dim Sh As Worksheet Dim WB As Workbook Application.ScreenUpdating = False Application.DisplayAlerts = False fPass = ThisWorkbook.Path & "\フォルダ名\" buf = Dir(fPass & "*.xls") Do While Len(buf) > 0 Set WB = Workbooks.Open(Filename:=fPass & buf, UpdateLinks:=0) For Each Sh In WB.Sheets Sh.UsedRange.Value = Sh.UsedRange.Value Next Sh WB.Close 1 buf = Dir() Loop Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub (助六) 2020/05/11(月) 15:58
xlsxやxlsmは無い、でいいですか? (OK) 2020/05/11(月) 16:00
助六さんのコードの
>buf = Dir(fPass & "*.xls")
を
buf = Dir(fPass & "*.xls*")
にすればいけると思います。 (OK) 2020/05/17(日) 23:26
「Dir関数で3文字の拡張子を指定した場合、その3文字「で始まる」拡張子が該当すると判断されます。」
らしいです。
(通行人) 2020/05/18(月) 00:43
これすか?
https://www.moug.net/tech/exvba/0100048.html
(OK) 2020/05/18(月) 08:03
>「Dir関数で3文字の拡張子を指定した場合、その3文字「で始まる」拡張子が該当すると判断されます。」 やってみましたが、ならなかったです。
ファイルシステムがFATならありそうな話ですが、NTFSだとどうなんでしょうね。 FATのドライブもってないのでテストできません。
buf = Dir(fPass & "*.xls*") にしておくほうが安全だと思います。 (´・ω・`) 2020/05/18(月) 09:15
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.