VBA フォルダ内の全てブックの特定の行の削除方法

VBAで質問させて下さい。
指定したフォルダ内にある全てのブックにて、セル「B35」が０だった場合、その行を削除する
というコードが上手く動きません。

出来ない箇所：行の削除、処理済みのブックを閉じる

色々と検索しましたが分からなかったので、ご教授頂けると大変助かります。
どうぞよろしくお願いいたします。

----------------------ここから↓-----------------
Sub 修正()
Dim xlAPP As Application
Dim strPathName As String
Dim strFileName As String
Dim swESC As Boolean

' 「フォルダの参照」よりフォルダ名の取得
strPathName = BrowseForFolder("フォルダを指定して下さい", True)
If strPathName = "" Then Exit Sub

' 指定フォルダ内のExcelワークブックのファイル名を参照する
strFileName = Dir(strPathName & "\*.xls", vbNormal)
If strFileName = "" Then
MsgBox "このフォルダにはExcelワークブックは存在しません。"
Exit Sub
End If

Set xlAPP = Application
With xlAPP
.ScreenUpdating = False ' 画面描画停止
.EnableEvents = False ' イベント動作停止
.EnableCancelKey = xlErrorHandler ' Escキーでエラートラップする
.Cursor = xlWait ' カーソルを砂時計にする
End With
On Error GoTo Button1_Click_ESC

' 指定フォルダの全Excelワークブックについて繰り返す
Do While strFileName <> ""
' Escキー打鍵判定
DoEvents
If swESC = True Then
' 中断するのかをメッセージで確認
If MsgBox("中断キーが押されました。ここで終了しますか？", _
vbInformation + vbYesNo) = vbYes Then
GoTo Button1_Click_EXIT
Else
swESC = False
End If
End If

'-----------------------------------------------------------------------
' 検索した１ファイル単位の処理
Call OneWorkbookProc(xlAPP, strPathName, strFileName)

'-----------------------------------------------------------------------
' 次のファイル名を参照
strFileName = Dir
Loop
GoTo Button1_Click_EXIT

'----------------
' Escキー脱出用行ラベル
Button1_Click_ESC:
If Err.Number = 18 Then
' EscキーでのエラーRaise
swESC = True
Resume
ElseIf Err.Number = 1004 Then
' 隠しシートや印刷対象なしの実行時エラーは無視
Resume Next
Else
' その他のエラーはメッセージ表示後終了
MsgBox Err.Description
End If

'----------------
' 処理終了
Button1_Click_EXIT:
With xlAPP
.StatusBar = False ' ステータスバーを復帰
.EnableEvents = True ' イベント動作再開
.EnableCancelKey = xlInterrupt ' Escキー動作を戻す
.Cursor = xlDefault ' カーソルをデフォルトにする
.ScreenUpdating = True ' 画面描画再開
End With
Set xlAPP = Nothing
End Sub

'*******************************************************************************
' １つのワークブックの処理
'*******************************************************************************
Private Sub OneWorkbookProc(xlAPP As Application, _
strPathName As String, _
strFileName As String)
Dim R As Range

'---------------------------------------------------------------------------
Dim objWBK As Workbook ' ワークブックObject
' ステータスバーに処理ファイル名を表示
xlAPP.StatusBar = strFileName & "修正中．．．．"
' ワークブックを開く
Set objWBK = Workbooks.Open(Filename:=strPathName & cnsYEN & strFileName, _
UpdateLinks:=True, _
ReadOnly:=False)
'---------------------------------------------------------------------------
' ↓↓↓ 検索した１ファイル単位の処理 ↓↓↓
Set R = ActiveSheet.Range("B35").Find(What:="0", LookAt:=xlWhole)
If R Is Nothing Then Exit Sub
R.EntireRow.Delete

' ↑↑↑ 検索した１ファイル単位の処理 ↑↑↑
'---------------------------------------------------------------------------
' 開いたブックをClose
objWBK.Close SaveChanges:=True
Set objWBK = Nothing
End Sub

No.1 ベストアンサー 回答者： over_the_galaxy 回答日時： 2014/02/11 12:28

B35がゼロなら行削除

If ActiveSheet.Range("B35")=0 then
Rows("35:35").Delete Shift:=xlUp
End if

ブックを閉じる
ActiveWorkbook.Save
ActiveWorkbook.Close

自動マクロを使うと、記録された内容を見て参考に出来ます。コマンドが分からない場合に便利です。

この回答へのお礼

ありがとう御座います！うまく動きました！！
自動マクロは余り使用したことがなかったのですが、そういう使い方も出来るのは盲点でした。
色々と活用してもっと勉強していきたと思います。

お礼日時：2014/02/12 13:24