こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

決められたセル範囲のみ別ファイルに保存するマクロ

Book内のシートSheet1,Sheet2,Sheet3を別個のCSVファイルSheet1.csv/Sheet2.csv/Sheet3.csvとして保存したいです。
過去ログを参考に以下のコードで正常に動作しました。
For Num = 1 To 3
SheetName = "Sheet" & Num
Worksheets(SheetName).Copy
ActiveSheet.SaveAs Filename:=myPath & SheetName, FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close False
Next

ここで、
決められたセル範囲A1:D5に書かれたデータのみをCSVファイルとして保存する、
といったことをしたいのですが、記述の仕方を教えてください。
その範囲以外が削除されてしまっても構わないので、
その範囲以外をクリアしてから保存を実行、というコードも組んだのですが、
上書き保存されているシートに対して行うとクリアする前の状態のシートをコピーするようで、失敗しました。

Worksheets(SheetName).Copyの部分を、
Sheets(SheetName).Select
Range("A1:D5").Copy
と変えてみたのですが、マクロを実行したファイルが閉じてしまい、巧く動きません。
※myPathには保存先フォルダのパスが入ります。

また、保存の際に「同名のファイルがあるが、上書きするか?」のメッセージを出さずに強制的に上書きにする方法はありますか?

投稿日時 - 2007-05-01 17:55:04

QNo.2965388

暇なときに回答ください

質問者が選んだベストアンサー

こんにちは。

以前の私のコードの書き方に、良く似ていますね。特に、.Close False は、私の独特の考えで書いているからです。

ただ、私のオリジナルは、こういう書き方ではなくて、直接、CSVを作ってしまうのですが、あくまでも、掲示板で公開するためのものです。

>保存の際に「同名のファイルがあるが、上書きするか?」
は、Application.DisplayAlart =False
です。

今回は、二種類作ってみました。
TestSample1
>その範囲以外が削除されてしまっても構わないので、
>その範囲以外をクリアしてから保存を実行、というコード

TestSample2

その範囲以外が削除されてしまっては、困る場合
シート名のファイルがない場合は、その範囲のみCSVにします。

------------------------------------------------------
Sub TestSample1()
  '規定の範囲のみを残す
  Dim Num As Integer
  Dim myPath As String
  Dim SheetName As String
  Dim r As Range
  
  Const MYRNG As String = "A1:D5" '規定の範囲のみを残す
  ' ="" とすれば、シート全体がコピーされる
  'ユーザー任意
  myPath = Application.DefaultFilePath & "\"
  
  Application.ScreenUpdating = False
  For Num = 1 To 3
    SheetName = "Sheet" & Num
    If MYRNG <> "" Then
      Set r = Worksheets(SheetName).Range(MYRNG)
    End If
    Worksheets(SheetName).Copy
    With ActiveSheet
      If MYRNG <> "" Then
        .UsedRange.Clear 'シートのデータを削除
        r.Copy .Range("A1") 'データのコピー&ペースト
      End If
      Application.DisplayAlerts = False
      .SaveAs FileName:=myPath & SheetName, _
      FileFormat:=xlCSV, _
      CreateBackup:=False
      Application.DisplayAlerts = True
    End With
    ActiveWorkbook.Close False
  Next
  Application.ScreenUpdating = True
End Sub

------------------------------------------------------
Sub TestSample2()
'規定の範囲のみを書き換える
  Dim Num As Integer
  Dim myPath As String
  Dim SheetName As String
  Dim FileName As String
  Dim r As Range
  
  Const MYRNG As String = "A1:D5" '規定の範囲のみを書き換える
  'ユーザー任意
  myPath = Application.DefaultFilePath & "\"
  
  Application.ScreenUpdating = False
  For Num = 1 To 3
    SheetName = "Sheet" & Num
    Set r = Worksheets(SheetName).Range(MYRNG)
    
    FileName = myPath & SheetName & ".csv"
    
    If Dir(FileName) <> "" Then
     
     With Workbooks.Open(FileName)
      r.Copy .ActiveSheet.Range(MYRNG)
     End With
    
    Else
    
    Worksheets(SheetName).Copy
    With ActiveSheet
      .UsedRange.Clear
      r.Copy .Range("A1")
    End With
    End If
    
   Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs FileName:=myPath & SheetName, _
      FileFormat:=xlCSV, _
      CreateBackup:=False
   Application.DisplayAlerts = True
    ActiveWorkbook.Close False
  Next
  Application.ScreenUpdating = True
End Sub

投稿日時 - 2007-05-01 19:18:07

お礼

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

わざわざ2つもありがとうございます。
後者が理想だったのでこちらを組み込んでいる最中です。
(自分にとっては)コードが長くなってきて混乱し始めました。
変数rに入っている情報はデバッグ時にカーソルを合わせても表示されないようですが、
ここにコピー範囲などが入っているものとして扱っています。

>以前の私のコードの書き方に、良く似ていますね。
過去ログを参考に、と書きましたが、
コードは載っていたもののほぼパクりなので、Wendy02さんの書いた記事だったかもしれません。

投稿日時 - 2007-05-02 14:26:25

ANo.2

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

#01です。「コピーしたシートを消す」と「元のブック名を変えない」ようにしました。また同名ファイルがある場合は警告なしで上書きします

For Num = 1 To 3
SheetName = "Sheet" & Num
Worksheets(SheetName).Range("A1:D5").Copy
WorkSheets.Add
ActiveSheet.Paste
Application.DisplayAlerts = False
ActiveSheet.SaveCopyAs Filename:=myPath & SheetName, _
  FileFormat:=xlCSV, CreateBackup:=False
ActiveSheet.Delete
Application.DisplayAlerts = True
Next

投稿日時 - 2007-05-01 21:43:27

お礼

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

注文つけちゃって申し訳ありません。
挙げていただいたコード、1行ずつ解析します。

投稿日時 - 2007-05-02 14:28:26

ANo.1

For Num = 1 To 3
SheetName = "Sheet" & Num
Worksheets(SheetName).Range("A1:D5").Copy
WorkSheets.Add
ActiveSheet.Paste
ActiveSheet.SaveAs Filename:=myPath & SheetName, _
  FileFormat:=xlCSV, CreateBackup:=False
Next
ActiveWorkbook.Close False

ではどうでしょうか。「マクロを実行したファイルが閉じてしまい」はFor~Nextの中でCloseしているからです

「同名のファイルがあるが、上書きするか?」のメッセージを出さない方法として
 Application.DisplayAlerts = False
 ThisWorkBook.SaveAs …
 Application.DisplayAlerts = True
があります。

投稿日時 - 2007-05-01 18:22:52

補足

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

求めていた部分は正常に動作しました。
ただ、
・実行後、Book内にSheet4~6というシートが残ってしまう
・実行後、Book名がSheet3.csvになってしまう
という新たな問題が発生してしまいました。
最初に挙げたコードでFor~Nextの中でCloseしているのは、
CSVファイルの保存に使ったシートSheet4~6を閉じるつもりで配置したものです。
・Book内にシートを増やさない
・マクロ実行後、マクロを実行したBookを開いている状態に
この2点、なんとかなるようでしたらよろしくお願いします。

投稿日時 - 2007-05-01 19:15:29

あなたにオススメの質問