|
ありがとうございます。
自動転記の部分入れてみましたが、
まったくどのファイルにも変化が見られないのは
なぜでしょうか?
一つ一つファイルは開いてシートを見に行っている
ようなんですが・・・。
replaceの部分がおかしいとしか思えません。
Sub 置換()
Dim ws As Worksheet
Dim wb As Workbook
Dim strPath As String
Dim strFileName As String
Set ws = ActiveSheet
'ブックが格納されているフォルダ(マクロブックと同じフォルダの場合)
strPath = ThisWorkbook.Path
strFileName = Dir(ThisWorkbook.Path & "\*.xls")
Do Until strFileName = ""
If strFileName <> ThisWorkbook.Name Then
'ブックを開く
Set wb = Workbooks.Open(strPath & "\" & strFileName)
'開いたブックをのすべてのシートをひとつずつアクティブにする
For Each ws In Worksheets
ws.Activate
Cells.Replace What:="2007年", Replacement:="翌年", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="2006年", Replacement:="当年", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next
'開いたブックを上書き保存する
wb.Save
'開いたブックを上書き保存しない
'wb.Saved = True
'開いたブックを閉じる
wb.Close
End If
strFileName = Dir()
Loop
MsgBox "終了しました"
End Sub
|
|