エクセル・マクロ(VBA)で、指定範囲を保存したい。

質問

エクセルマクロ（ＶＢＡ）で、セル範囲を指定してその指定した部分だけをファイルに保存したいのですが、どのようにしたらよろしいのでしょうか？

回答No.3

Wendy02 · ベストアンサー

私が考えていたのと、ちょっと趣旨がちがっちゃったですね。
#1 のレスについていたのをちょっと付け足して、変更してみました。

Sub test_1()
Worksheets("sheet1").Range("A1:F12").Copy
With Workbooks.Add
　ActiveSheet.Paste
　Application.DisplayAlerts = False '同じ名前があった時上書き
　ActiveWorkbook.SaveAs Filename:= _
　 "C:\Documents and Settings\システム\" & Date$ & ".xls" _
　, FileFormat:=xlNormal _
　, Password:="00000000" _
　, WriteResPassword:="11111111" _
　, ReadOnlyRecommended:=True _
　, CreateBackup:=False
　Application.DisplayAlerts = True
　.Close False '閉じる
End With
End Sub

'*****************************************
以下は、私が考えたものです。参考にしてみてください。
つまり、同名のファイルがあった時の処理を考えてみました。
少しは、参考になるかもね。（^^;

Sub Selection_CopySave()
　Dim Rng As Range
　Dim rtn As Boolean
　Set Rng = Selection　'マウスで複数のセルを選択してください。
　If Rng.Count = 1 Then Exit Sub
　Rng.Copy
　With Workbooks.Add
　　ActiveSheet.Paste
　　Do
　　　rtn = FileCheck
　　Loop While rtn = True
　　.Close False '閉じる
　End With
　Application.CutCopyMode = True
End Sub
Private Function FileCheck() As Boolean
Dim Fname As String
Dim rtn As Integer
Dim flg As Boolean
　　flg = False
　　Fname = Application.GetSaveAsFilename(Date$, "エクセルブック (*.xls), *.xls")
　　If Fname <> "False" Then
　　　If Dir(Fname) = "" Then
　　　　Application.DisplayAlerts = False
　　　　ActiveWorkbook.SaveAs Fname _
　　　　　, FileFormat:=xlNormal _
　　　　　, Password:="00000000" _
　　　　　, WriteResPassword:="11111111" _
　　　　　, ReadOnlyRecommended:=True _
　　　　　, CreateBackup:=False
　　　　Application.DisplayAlerts = True
　　　　Else
　　　　rtn = MsgBox("同名のファイルがあります。上書きしますか？", vbYesNoCancel)
　　　　If rtn = vbYes Then
　　　　　ActiveWorkbook.Save
　　　　ElseIf rtn = vbNo Then
　　　　　flg = True
　　　　ElseIf rtn = vbCancel Then
　　　　　FileCheck = False
　　　　　Exit Function
　　　　End If
　　　End If
　　End If
　　FileCheck = flg
End Function

お礼

たった今、拝見したばかりですので、よく見させていただきます。
取り急ぎご挨拶まで。
ＶＢＡは、初めてで、これからいろいろと作成していきたいものがありますので、参考に致します。

また、お世話になることがあると思いますが、よろしくお願いいたします。

回答No.5

at121

sheet2 sheet3 がつくのがいやな場合
保存先パスは定時・定型業務に応じて固定

Sub 選択範囲を新規Book_YYYYMMDDに保存()
'
保存先パス = ".\"
'保存先パス = "C:\Documents and Settings\システム\"
保存新規Book名 = Format(Now, "データYYYYMMDD") & ".xls"
保存シート名 = Date$

If Dir(保存先パス & 保存新規Book名) <> "" Then
If MsgBox(保存新規Book名 & vbCrLf & "既存のFileを削除・新規上書きします。 ", vbOKCancel) = vbOK Then
Kill (保存先パス & 保存新規Book名)
Else
Exit Sub
End If
End If

Selection.Copy
Sheets.Add before:=Sheets(1)
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets(1).Move
Sheets(1).Name = 保存シート名
ActiveWorkbook.SaveAs Filename:=保存先パス & 保存新規Book名
ActiveWindow.Close

End Sub

お礼

回答いただきまして、大変ありがとうございました。
素人同然の小職に回答下さいまして感謝しております。
今後も、皆様にご迷惑をお掛けすることもあるとおもいますが、よろしくお願いいたします。

回答No.4

KenKen_SP

#1です。

あらら、、出遅れましたね。ほとんどWendy02さんと同じですが、、
違いは、

Selection.Copy
Worksheets("sheet1").Range("A1:F12").Copy

ですかね。

Wendy02さんがコメントされてますが、私も同名ファイルがあった場合の処理を考えた方が良いと思います。

Sub Sample()

　　'選択範囲コピー
　　Selection.Copy
　　'新規ブックの追加
　　Set WB = Workbooks.Add
　　　　'一応新規ブックをアクティブにする
　　　　WB.Activate
　　　　'アクティブシートに貼り付け
　　　　ActiveSheet.Paste
　　　　'保存する
　　　　WB.SaveAs _
　　　　　　Filename:="C:\Documents and Settings\システム\" & Date$ & ".xls", _
　　　　　　FileFormat:=xlNormal, _
　　　　　　Password:="00000000", _
　　　　　　WriteResPassword:="11111111", _
　　　　　　ReadOnlyRecommended:=True, _
　　　　　　CreateBackup:=False
　　'変数の解放
　　Set WB = Nothing
　　Application.CutCopyMode = False

End Sub

お礼

たった今、拝見したばかりですので、これからよく見させていただきます。
ＶＢＡは、初めてで、これからいろいろと作成していきたいものがありますので、参考に致します。
小職のような者のために、皆様に助けていただきたい変換謝しております。
また、お世話になることがあると思いますが、よろしくお願いいたします。

回答No.2

masa0690831

データをどのように利用することを考えておられるのかわかりませんが、
マクロでWorksheetの部分データをCSV形式又はTXT形式で書出す、それを読み込むことが出来ます。
Sampleを呈示することも出来ますが、利用方法を教えて下さい。
下記にVBAに関するサイトの一部をあげておきます。
特に参考URLのサイトにはご希望に近い内容が含まれているようです。ご参考に。
http://www.voicechatjapan.com/excelvba/
http://www.max.hi-ho.ne.jp/~happy/YNxv8316.html
http://www2.moug.net/app/bbs/thread.php?cat=acm_v
http://homepage3.nifty.com/bear/

参考URL：

http://www.bekkoame.ne.jp/~poetlabo/COMP/Excel/VBASAMP/

お礼

ありがとうございました。
今後、参考とさせていただきます。

ＶＢＡは、初めてで、これからいろいろと作成していきたいものがありますので、参考に致します。

また、お世話になることがあると思いますが、よろしくお願いいたします。

回答No.1

KenKen_SP

こんにちは。

ご質問の意味がわかりません。

＞ファイルに保存したい

どのように保存するのですか?新規ブック?テキスト?

＞セル範囲を指定してその指定した部分だけ

連続しない（とびとびの）セルが選択されている場合は、どうするのですか?

もっと具体的に「やりたいこと」を示していただかないと回答できないと思いますよ。

まず、「やりたいこと」を「新しいマクロの記録」で記録してみたらどうですか?
その上で、

・記録されたコード
・具体的にやりたいこと
・マクロの記録で作成されたマクロでは上手く機能しない部分

を補足して下さい。

補足

済みませんでした。

ワークシート内の指定した範囲内だけを新規ブックとして保存したいのです。なお、連続しないセルは無い状態です。
マクロ記録を行ってみたのですが、ブック全体を保存してしまい、指定した部分だけを保存するという方法がわかりませんでした。

記録したマクロは、以下の通りです。

With Worksheets("sheet1")
　.Range.Cells("A1:F12").Select
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\システム\("&Date$
　 & ").xls" _
　, FileFormat:=xlNormal
　, Password:="00000000"
　, WriteResPassword:="11111111"
　, ReadOnlyRecommended:=True
　, CreateBackup:=False
End With

『ActiveWorkbook.SaveAs ・・・』の部分を『ActiveCells.saveAs ・・・』に変更してみたのですが、うまく動きませんでした。