• 締切済み

Excelで最終行の空白を削除にする

eden3616の回答

  • eden3616
  • ベストアンサー率65% (267/405)
回答No.1

こちらの環境(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

oimoita
質問者

補足

ご回答ありがとうございます。 うまくいかない→アクティブセルは閉じる前にアクティブになっている部分から移動しません。 コードの位置を変えても変わりませんでした。 但し、バックアップされたExcelデータ内ではA列の最終行に移動していました。 (コードをどの位置においても) データを閉じる前には瞬間的にアクティブセルがA列の空白行に移っているところが見えるのですが、なぜなのでしょうか?

関連するQ&A

  • VBA 選択したセルが空白であったらシートを削除

    こんばんは!いつもお世話になっています。 選択したシート1のセル(C9)が空白であったら、選択したシートを削除するマクロ(VBA)を作りましたが、上手く作動しなくて困っています。 どうしたらよいのかよろしくお願い致します。 'シート1のセルC9を選択し、空白か判断する Sub セルの選択()   Worksheets("Sheet1").Activate   Range("C9").Select  If Len(Application.Trim(ActiveCell)) = 0 Then   MsgBox("空白セル")  End If End Sub '現在アクティブなシートを削除する Sub DeleteWorksheet() Application.DisplayAlerts = False ActiveSheet.Delete Application.DisplayAlerts = True End Sub

  • VBAで空白行を削除する

    VBAでリストの空白行を削除するための適当なコードを探しているのですがどんぴしゃのものが中々見つかりません。ご教授下さい。 ブックBのシートBのリストにはA2~AN●まで値が入っています。 別のブックAからVBAで値を取り出し貼り付けています。 いくつかの方法を試しました。 (1)ブックを開いたときに空白行を削除 Sub Auto_Open() '空白行を削除 Dim lRow As Long Dim i As Long lRow = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For i = lRow To 2 Step -1 If Cells(i, 1).Value = "" Then Range(i & ":" & i).Delete End If Next i Application.ScreenUpdating = True End Sub 5分以上砂時計のままで結局終わりません。 強制終了させ再度ブックを開くと空白行は削除されているのですが、こんな動作では使うことができません。 (2)ブックAの値を貼り付けた後、空白行を削除し上書き保存する Sub エクスポート() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Range(Cells(5, 7), Cells(79, 46)).Select Selection.Copy 'コピー Workbooks.Open Filename:="\\パス\ブックB.xlsm" '貼り付け先ファイルオープン Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '貼り付け Dim lRow As Long Dim i As Long lRow = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For i = lRow To 2 Step -1 If Cells(i, 1).Value = "" Then Range(i & ":" & i).Delete End If Next i Application.ScreenUpdating = True  '空白行を削除 ActiveWorkbook.Save '上書き保存 Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub (3)空白行を削除の部分は以下のコードも試しました Worksheets("SheetB").Range("A1").Select Set currentCell = Worksheets("sheetB").Range("A1") Do While Not IsEmpty(currentCell) Set nextCell = currentCell.Offset(1, 0) If Not IsEmpty(currentCell) Then 'カレントセルが空白でなく、 If IsEmpty(nextCell) Then '次のセルが空白のとき nextCell.EntireRow.Delete End If End If Set currentCell = currentCell.Offset(1, 0) Loop '空白行削除 宜しくお願い致します。

  • 空白のセルを行削除する。EXCELマクロなのですが・・

    VBA初心者です。 データーをHPから、単純にコピーしてきて、 EXCELに貼り付けています。 フィルターをかけても、画像かなにかがセルに張り付いているのか、 空白行をすべて削除できません。 いろいろ試して(HPから、空白セルの行削除について書かれてあるマクロを貼り付けて)動いたのが、このVBAです。 しかし、遅いので、早いVBAに簡略できればいいのですが。。 大体、1000行ぐらいの文字を貼り付けて、3/1ぐらいが空白行です。A行のセルの空白のみを、削除したいのですが。  まったくの素人なので、わかりません。 どうかよろしくお願いいたします。 Sub 空白の削除() x% = Worksheets("sheet1").Range("A65536").End(xlUp).Row For i = x% To 1 Step -1 If Worksheets("sheet1").Cells(i, 1).Value = "" Then Worksheets("sheet1").Rows(i).Delete Next End Sub

  • なぜShowAllDataだとうまく行かないのでし

    なぜShowAllDataだとうまく行かないのでしょう? 「オートフィルタがかかってるなら解除する」 と言うコードを勉強しているのですが Sub a() If ActiveSheet.AutoFilterMode = True Then ActiveSheet.ShowAllData End If End Sub とすると、実行時エラー1004になります。 Sub b() If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False End If End Sub すると正常に動きます。 ActiveSheet.ShowAllData= True にしてもダメでした。

  • エクセルVBAの別sheetの空白行削除について

    エクセルVBAでBOOK1のsheet1とsheet2とsheet3があり、 sheet1とsheet2の全ての情報をsheet3にコピーしてまとめるようにしました。 マクロを実行するには、Visual Basicを開いてF5を押しています。 それをsheet1かsheet2の中身の一部分でも変更すると そのときに自動的にマクロが実行されるようにしたいです。 sheet1とsheet2(sheet3は空白のまま)に Private Sub Worksheet_Change(ByVal Target As Range) Call マクロ() End Sub を入れ、 次に、標準モジュールに Sub マクロ() '下記よりsheet1とsheet2の内容をsheet3にコピーする Worksheets("sheet1").Range("C1:BE50").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50") Worksheets("sheet2").Range("C1:BE100").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150") '下記より上記sheet3の状態から余分な空白行を削除する Dim UsedCell As Range Dim Max_Row, RowCount As Integer Set UsedCell = ActiveSheet.UsedRange Max_Row = UsedCell.Cells(UsedCell.Count).Row Application.ScreenUpdating = False For RowCount = Max_Row To 1 Step -1 If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then Rows(RowCount).Delete End If Next Application.ScreenUpdating = True End Sub をやって、sheet1かsheet2のセルを変更すると エクセルが固まってしまいます。 デバックでは Rows(RowCount).Delete がよくないようです。 書き方が間違っているのでしょうか?

  • (VBA)フィルタがかかっているかどうかの判断方法

    フィルタがかかっているかどうかを取得したいのですが フィルタがかかっているシートにて Sub test1() If ActiveSheet.FilterMode Then MsgBox "フィルタがかかってます" End If End Sub Sub test1の1() If ActiveSheet.FilterMode = True Then MsgBox "フィルタがかかってます" End If End Sub を実行しても"フィルタがかかってます"は表示されません。 Sub test2() If Rows(1).FilterMode Then MsgBox "フィルタがかかってます" End If End Sub Sub test3() If ActiveSheet.Rows(1).FilterMode Then MsgBox "フィルタがかかってます" End If End Sub こちらは オブジェクトは、このプロパティまたはメソッドをサポートしていません。(Error 438) になってしまいます。 フィルタがかかっているか調べる方法はありますか? よろしくお願いします。

  • Excel テーブル内の空白行の削除について

    テーブルの任意の行のデータを削除し、空白削除ボタン(cmd_Blank)をクリックすると削除したデータ行(空白行)を削除するVBAを作ったのですが空白行が1つの場合は問題なく動作するのですが(添付左)、 ・空白セルがあるとその行がすべて削除されてしまう(添付中央)。 ・空白行が2つ以上あるとエラーになってしまう(添付右) という問題に悩んでいます。 空白削除ボタンクリック時のコードは Private Sub cmdBlank_Click() ActiveSheet.ListObjects("T住所").DataBodyRange.SpecialCells(xlCellTypeBlanks).EntireRow.Delete End Sub になります。 添付の図がわかりにくいかと思いますが、ボタンクリックすると テーブル内の空白行があったら、その行のみ削除され、上詰めに したいということです。 どなたか教えていただきたいです。

  • Excel 偶数番シートのA列が空白であるセル削除

    Excel の1つのファイル内の偶数番シートのA列が空白であるセルを行ごと削除したいのですが、下のコードではうまく動かないです。 シート番号はSheet(2)から(90)までです。 Sub 空白行削除() Dim i For i = 2 To 90 Step 2 Worksheets(i).Activate Columns("A:A").Select Selection.SpecialCells(xlCellTypeBlanks).Select Selection.EntireRow.Delete Next i End Sub

  • エクセルでマクロを組み始めたばかりの者です。下記の

    エクセルでマクロを組み始めたばかりの者です。下記のようなマクロを組んでみましたが、27行目もしくは41行目のActiveSheet.Pasteで「実行時エラー‘1004‘: 変更しようとしているセルまたはグラフは保護されているため読み取り専用となっています…」というエラーメッセージが出て止まってしまいます。 しようとしている内容は、転送ボタンを押し各シートの指定セルへ一括転送(コピー)をしたいのです。 その際、転送先はシート保護をしておきたいのです。 エラーはエクセル2010で確認しましたが、職場のPCを使用するため2007や2003等他のバージョンを利用する可能性もあります。また、仕事で使用するため早急に使わなければならず焦っています。 Option Explicit Private Sub CommandButton2_Click() Call Macro2 End Sub Sub Macro2() Workbook.Open Filename:=”K:¥共有¥○○○.xlsm” ActiveSheet.Unprotect ThisWorkbook.Activate Range(”D4:G20”).Select Selection.Copy Windows(”○○○.xlsm”).Activate Range(”E7”).Select ActiveSheet.Paste Application.CutCopyMode = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveWorkbook.Save ActiveWindow.Close Application.CutCopyMode = False Workbook.Open Filename:=”C:¥Users¥Desktop¥×××.xlsm” ActiveSheet.Unprotect ThisWorkbook.Activate Range(”D4:G20”).Select Selection.Copy Windows(”×××.xlsm”).Activate Sheet(”△△△”).Select Range(”AF18:AI34”).Select ActiveSheet.Paste Application.CutCopyMode = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveWorkbook.Save ActiveWindow.Close Application.CutCopyMode = False Workbook.Open Filename:=”K:¥共有¥□□□.xlsm” ActiveSheet.Unprotect ThisWorkbook.Activate Range(”D4:G20”).Select Selection.Copy Windows(”□□□.xlsm”).Activate Sheet(”▽▽▽”).Select Range(”AF18:AI34”).Select ActiveSheet.Paste Application.CutCopyMode = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveWorkbook.Save ActiveWindow.Close Application.CutCopyMode = False MsgBox " 『○○○』と" & vbCrLf & "『×××』と" & vbCrLf & "『□□□』の" & vbCrLf & "規格を変更しました。" End Sub どの様に修正すれば良いのでしょうか? マクロが原因でしょうか?または他の原因があるのでしょうか? マクロ初心者のため、修正方法など具体的な詳細をお教えいただけないでしょうか。 お手数をおかけして申し訳ございませんが、よろしくお願いします。

  • 「シート1のアクティブセルをコピーしてシート2のA列の最終行+1に貼り付ける」

    「シート1のアクティブセルをコピーしてシート2のA列の最終行+1に貼り付ける」 というVBAコードが知りたいのですが Sub Macro1() Selection.Copy Sheets("Sheet2").Select Selection.End(xlDown).Offset(1).Select ActiveSheet.Paste End Sub ではうまくいきませんでした。 ・マクロを実行する前のもともとのアクティブセルはシート1の入力されたセル上にあるとします。 ・シート2のA列にはA1~A?と削除したり挿入したりで数が変わりますが何かしら文字列が隙間なく入っています。 よろしくお願いします。