Ｅｘｃｅｌで最終行の空白を削除にする

質問

ExcelのVBAでつまづいています。

以下のようにコードを書きました。

Sub Auto_Close()

Worksheets("Sheet1").Select 'シート1を開く

If ActiveSheet.FilterMode = True Then

ActiveSheet.ShowAllData

End If 'フィルタをすべてチェックする

Filename = Format(Now(), "yyyy-mm-dd-hh-mm-ss")

ThisWorkbook.SaveAs Filename:="\\●●●●\●●●●\●●●●\●●●●\●●●●\" & Filename & ".xlsm" 'Excelデータをバックアップ

ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select '一番左下の空白セルに移動

ActiveWorkbook.Save '開いているセルを上書き保存

End Sub

次に開いたときにはＡ列最終行の空白がアクティブになっているはずなのですが、うまくいきません。
バックアップのコードを削除するとうまくいくのですが、なぜそうなるのか意味がわかりません。
どこがおかしいですか？

回答No.5

cj_mover

こんにちは。お邪魔します。

ちょっとあやうい感じなので、ハッキリ書きますが、
設計的に無理があると思います。

大前提として、
　「バックアップファイルを作成保存するタイミング」
は、
　「自ブックを上書き保存するタイミング」
です。
他のタイミングではバックアップになりません。

バックアップというからには、目的を持って
開くこともあります。
閉じることもあります。
バックアップファイルにもマクロは残っています。
バックアップのバックアップを作成することが必要でしょうか？
仮に必要だとして、では、
どれがバックアップで
どれがバックアップのバックアップであると
どうやって見分けますか？
ここまでに提示されたコードでのシステムは、
最新の時刻のバックアップブックが、
最新のものではない可能性がある訳です。
または、バックアップブック名に含ませた
日付時刻が、作業上のバージョンの順を示さない可能性がある訳です。
つまり、バックアップとして機能しません。

ひとつの考え方として、
マクロ（VBAProject）を抜きにした形で保存することも可能です。
実際、データのバックアップだけが目的なら、マクロは要らないですから、
csvテキストで保存するなり、丁寧にマクロを抜いて保存するなり、
方法は様々あります。
ただ、それは、全体の設計が確定して、
ＶＢＡも完成した時に考えればいいことです。
現時点で、ＶＢＡの記述（というより設計面）が固まっていないのですから、
ありのままのブックをバックアップしておくべきです。

マクロを無効にして開けばいい、閉じればいい、
等のご都合主義も、条件付きで可能ですが、
システムとして正しい設計と呼べるものではありませんよね。
ブックの名前で判別するというのも、次月度、次年度、の更新
等あるでしょうから、原本ブックの名前変更もあり得るでしょうから、
よほどしっかりしたマニュアルを残すか、
マクロで更新処理できるようにしないと不安が残ります。

そもそものバックアップの意味としては、
　　「前回（前々回）保存時のバージョン」
というのが一般的な考え方です。
（Excel2007以降の自動バックアップは技術も目的も異質なものです）
ブックを閉じなくても上書き保存する時があれば、
その時にバックアップを採っておくのが
目的を最大限に活かすバックアップなのだと考えます。

ひとつの懸念として、より多くのバックアップファイルが作成されて
管理が面倒、という情緒的な問題があるかも知れません。
しかし、それこそＶＢＡでサポートするようにすればいいのだと考えます。
（もし必要なら別の機会に検討してください）
またしかし、開く・閉じる時にバックアップを採るにしても、
未保存データの有無を確認して判別しなければ、むしろ必要以上に
バックアップ量産体制になってしまうのかも知れませんね。
まったく同じ内容のファイルが異なる名前で複数存在するのは混乱の元です。
できちゃった時に削除するってのもキツイです。
ちょっと確認したいことがあって、編集目的以外で、開いたり閉じたり、、、
そういう時って、大抵、余計な手間を割いてる余裕がない時ですよね。

バックアップの目的が、版管理なのか、データの履歴管理なのか、
（本来は後者をバックアップとは呼ばないけれど、、、）
によっても多少方向性の違いはあるものですが、
（例えば、版の数を限定したい、とか、マクロを抜きたい、とか、、、）
それは置いておいて、、、。

以下、　「自ブックを上書き保存するタイミング」で
バックアップを採る場合の説明。

●ブックを閉じる時に、未保存データが無ければ、
Excelは上書き保存を求めたりしませんから、
無駄なバックアップ作成を省けます。

●ブックを閉じる時に、未保存データが有れば、
上書き保存を求めるダイアログへの返答に従って、
新しいバックアップを作成します。

●作業中に編集者がバックアップポイントを作る意味で、
上書き保存を実行した場合には、連動して、
新しいバックアップを作成します。
「フィルターの絞り込みを解除」
「Ａ列最下行の下を選択」
等は実行されますが、そのまま作業を再開できます。

●この方法では、バックアップファイル群の名前にある最新の日付時刻の
ひとつ前の日付時刻を名前に持つブックが、
直近の版（バックアップ）、ということになります。
（概ねフォルダ内の配置で２番目、という説明でも良さそうですけれど）

ThisWorkbook モジュールでWorkbook_BeforeSave イベントを使います。
これまでに提示された他の記述との共存は不可です。
他の部分のＶＢＡコードでThisWorkbook.Saveを書き込んでいる場合にも
_BeforeSave プロシージャが呼び出され、新しいバックアップを作成します。
バックアップを作成する記述が他にもある場合は、そちらも無効にします。
条件付きでバックアップ作成をキャンセルしたい上書き保存がある場合は、
キャンセル用のフラグをPublicで宣言して、フラグを立てる方法を用意し、
以下の_BeforeSave プロシージャの先頭に
　If フラグ Then Exit Sub
を書き加える等のやり方で、対策します。
もしも、既にWorkbook_BeforeSave プロシージャを使っている場合は、
組合わせが難しいでしょうから、補足にハッキリ書いて貰えれば、
対応します。

、、、以上、設計面での提案でした。乱筆乱文にて失礼。

以下、実装用の記述。

' ' 〓〓〓〓〓〓　ThisWorkbook モジュール　〓〓〓〓〓〓

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim sSrcBkName As String
Dim sBuBkName As String

' '　ーーーー 本来の上書き保存をキャンセル　ーーーー

　　Cancel = True

' '　ーーーー上書き保存前のルーティーン処理ーーーーー

　　With Sheets("Sheet1")
　　　　.Select　'　シート1を選択
　　　　If .FilterMode = True Then
　　　　　　.ShowAllData　'　フィルターの絞り込みを解除
　　　　End If
　　　　.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select　'　Ａ列最下行の下を選択
　　End With

' '　ーーーーーーーーーファイル名ーーーーーーーーーー

' ' 自ブックの名前をフルパスで確保
　　sSrcBkName = Me.FullName

' ' バックアップ用ブック名を指定　ドライブ名+:\+フォルダ名+\+名前(時刻)+拡張子
　　sBuBkName = "\\●●●●\●●●●\●●●●\●●●●\●●●●\" & Format(Now(), "yyyy-mm-dd-hh-mm-ss") & ".xlsm"

' '　ーーーーバックアップ作成 ＋ 上書き保存ーーーーー

' ' _BeforeSaveプロシージャの再帰的な呼び出しをキャンセル　イベント抑止
　　Application.EnableEvents = False

' ' 自ブックを　バックアップブック　として　名前を付けて保存
　　Me.SaveAs Filename:=sBuBkName　'　▼ここでバックアップブックがThisWorkbookになる▼

' ' 確認ダイアログの表示を無効化
　　Application.DisplayAlerts = False

' ' 自ブック(バックアップブック)　を　元々の自ブック　として　名前を付けて保存
' ' 表面的には本来の　上書き保存　の意味
　　Me.SaveAs Filename:=sSrcBkName　'　▼ここで元々の自ブックがThisWorkbookになる▼

' ' 確認ダイアログの表示を有効化
　　Application.DisplayAlerts = True
' ' イベント再開
　　Application.EnableEvents = True

End Sub

回答No.4

eden3616

No2のコードですが変なことしてますね。
訂正いたします。

最終の状態データ：ファイル名「最終のデータ.xlsm」
　　閉じる前にフィルターを全表示後、最終空白セルを選択して上書き保存

バックアップデータ：ファイル名「保存日.xlsm」
　　「最終データ.xlsm」を開いた時点のデータをバックアップファイルとして別名保存

する目的とします。

コードを記述するブック名を「最終のデータ.xlsm」にリネームした状態で以下のコードを
ThisWorkbookモジュールに記述してください。

「最終データ.xlsm」のファイル名を変更する場合は、
変更後のファイル名にリネームしてからファイルを開き、「Workbook_Open」プロシージャ内の
newNameの値を変更してください。

■ThisWorkbookモジュールに記述するコード

Public newName As String

Private Sub Workbook_Open()
newName = "最終データ.xlsm" '最終データのファイル名を設定
If ThisWorkbook.Name <> newName Then Exit Sub '最終データであれば終了
Filename = Format(Now(), "yyyy-mm-dd-hh-mm-ss")
ThisWorkbook.SaveCopyAs "\\ディレクトリ\" & Filename & ".xlsm"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ThisWorkbook.Name <> newName Then Exit Sub '最終データであれば終了
Worksheets("Sheet1").Select 'シート1を開く
If ActiveSheet.FilterMode = True Then
　　ActiveSheet.ShowAllData
End If 'フィルタをすべてチェックする
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select '一番左下の空白セルに移動
ThisWorkbook.Save '上書き保存
End Sub

回答No.3

mt2008

> ThisWorkbook.SaveAs Filename:="\\●●●●\●●●●\●●●●\●●●●\●●●●\" & Filename & ".xlsm" 'Excelデータをバックアップ

このコードを実行すると、ActiveWorkbookはバックアップファイル（例：2014-10-07-12-00-00.xlsm）になります。最後に↓のコードで自ファイルを保存しているつもりなのでしょうが、実際にはバックアップファイルをもう一度保存しています。
> ActiveWorkbook.Save '開いているセルを上書き保存

回答No.2

eden3616

>うまくいかない→アクティブセルは閉じる前にアクティブになっている部分から移動しません。
>但し、バックアップされたExcelデータ内ではA列の最終行に移動していました。

そりゃそうでしょう。
A列最終行の1個下を選択したデータは、現在の日付で名前を変えてから保存していますので。
初期のデータも選択セルを移動して保存するには上書き保存処理を前に盛ってくる必要があります。

Sub Auto_Close()
Worksheets("Sheet1").Select 'シート1を開く
If ActiveSheet.FilterMode = True Then
　　ActiveSheet.ShowAllData
End If 'フィルタをすべてチェックする
Filename = Format(Now(), "yyyy-mm-dd-hh-mm-ss")
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select '一番左下の空白セルに移動
ThisWorkbook.Save '上書き保存
ThisWorkbook.SaveAs Filename:="\\ディレクトリ\" & Filename & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled 'Excelデータをバックアップ
End Sub

そもそも、バックアップの作成目的が不明です。
本来バックアップは作業前のデータをバックアップするのではないでしょうか？
であれば、ブックオープン時に現状を保存したうえで、クローズ時に最終セルへ持っていく等に変更されてはどうでしょうか？

以下のコードはThisWorkbookモジュールに記述してください。
（Auto_Closeプロシージャは削除してください）

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Worksheets("Sheet1").Select 'シート1を開く
If ActiveSheet.FilterMode = True Then
　　ActiveSheet.ShowAllData
End If 'フィルタをすべてチェックする
Filename = Format(Now(), "yyyy-mm-dd-hh-mm-ss")
ThisWorkbook.SaveAs Filename:="\\ディレクトリ\" & Filename & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled 'Excelデータをバックアップ
End Sub

Private Sub Workbook_Open()
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select '一番左下の空白セルに移動
ThisWorkbook.Save
End Sub

回答No.1

eden3616

こちらの環境（2007）では正常に動作しますが。
「うまくいかない」とは具体的にどのような状態・どこが選択された状態となっているのでしょうか？

バックアップ　→　カーソル移動　→　上書き保存ですと
結局バックアップしたファイルにカーソル移動してから上書きしていますが

「ThisWorkbook.SaveAs Filename ～」のコードを上書き保存の場所へ移動して
上書き処理を削除してはどうでしょうか？
（新規ブックの場合エラーになるかとおもいますので、ファイルフォーマットも一応追加しています）

Sub Auto_Close()
Worksheets("Sheet1").Select 'シート1を開く
If ActiveSheet.FilterMode = True Then
　　ActiveSheet.ShowAllData
End If 'フィルタをすべてチェックする
Filename = Format(Now(), "yyyy-mm-dd-hh-mm-ss")
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select '一番左下の空白セルに移動
ThisWorkbook.SaveAs Filename:="\\ディレクトリ)\" & Filename & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled 'Excelデータをバックアップ
End Sub

補足

ご回答ありがとうございます。

うまくいかない→アクティブセルは閉じる前にアクティブになっている部分から移動しません。

コードの位置を変えても変わりませんでした。

但し、バックアップされたExcelデータ内ではA列の最終行に移動していました。
（コードをどの位置においても）

データを閉じる前には瞬間的にアクティブセルがA列の空白行に移っているところが見えるのですが、なぜなのでしょうか？