Excelのブックの中でを特定のシートだけを、名前を付けてを別のフォルダに保存する作業です。マクロを走らせて加工した後、ある特定のシートだけ保存するような場合に役に立ちます。VBAコードに追加してもいいですし、この作業だけ独立させてもかまいません。マクロ化せず、手動でやることもできますが、フォルダの場所を忘れたり、保存場所がフォルダの最下層のような深い位置にあったりして、そこにたどり着くまで何回もマウス操作をしなければならず私は飽きてしまいました。アプローチ方法は何通りもありそうですが私が行っている方法を紹介いたします。
1. 新たにファイル(ブック)を作成する方法
<例>シート名:sheet1 ファイル形式:Excelブック パス:C:\Users\user\Documents
ファイル名:保存ファイル
Sub 特定シートだけ別のフォルダに保存()
'シートの複製(複製すると新しいブックが立ち上がります)
Sheets("Sheet1").Copy '名前を付け、ファイル形式も決めて特定の場所に保存する。
ActiveWorkbook.SaveAs _
Filename:="C:\Users\user\Documents\保存ファイル", _
FileFormat:=xlOpenXMLWorkbook
End Sub
引数Filename:=以下をダブルクォーテーション(”)で囲み、中に保存したいフォルダのパス・ファイル名を書きます。これで任意の場所に保存できます。引数のFileFormatは、どのような拡張子(ファイル形式)で保存するのかを指定します。拡張子は今回は通常のExcelブックとして保存しています。
引数FileFormatによく使う定数(拡張子)
保存するブックの拡張子の違いによって、引数に入れる定数が異なります。定数は「名前」でも「値」でもどちらでも構いません。よく使うものだけ示しておきます。
拡張子 | 説明 | 名前 | 値 |
---|---|---|---|
.xlsx | Excel ブック | xlOpenXMLWorkbook | 51 |
.xls | Excel 97-2003 ブック | xlExcel8 | 56 |
.xlsm | Excel マクロ有効ブック | xlOpenXMLWorkbookMacroEnabled | 52 |
.csv | CSV | xlCSV | 6 |
.txt | テキストファイル | xlCurrentPlatformText | -4158 |
読み込みパスワード、書き込みパスワードの設定
最後に、保存する際に読み込みパスワードや書き込みパスワードを設定するコードを示します
Sub 特定シートだけ別のフォルダに保存()
'シートの複製(複製すると新しいブックが立ち上がります)
Sheets("Sheet1").Copy '名前を付け、ファイル形式も決めて特定の場所に保存する。
ActiveWorkbook.SaveAs _
Filename:="C:\Users\user\Documents\保存ファイル", _
FileFormat:=xlOpenXMLWorkbook _
Password:="password", _
WriteResPassword:="password1", _
ReadOnlyRecommended:=true
End Sub
上記コードのpassswordの引数に文字列入れると読み取り専用パスワードが設定され、WriteResPasswordの引数に文字列を入れると書き込みパスワードが設定されます。ファイルを開く際、読み取り専用を推奨するメッセージを出す場合には、ReadOnlyRecommendedの引数をtrueとします。
2.特定フォルダにある別ファイルを立ち上げて、特定シートの値を貼り付ける方法
これは、別ファイルに計算式等が入っていて、作成した特定のシートの値だけを貼り付けたい場合などに効力を発揮します。まあ、数式自体もVBAにしてしまうことができなくもないのですが、せっかく作ったファイルは再利用したいですよね。
<例>貼り付け先のファイル名:Book2 コピーの範囲:A列2行目(タイトル行を除く)からC列まで、行数は可変 パス:C:\Users\user\Documents
sub 特定の別ファイルに保存
'最終行の取得
Dim LstRow As Long
LstRow = Cells(Rows.Count, 1).End(xlUp).Row
'タイトル行(先頭行)を除き、A列からC列までコピー
Worksheets("Sheet1").Range("A2:C" & LstRow).Copy
'Book2ファイルを開く
Workbooks.Open "C:\Users\user\Documents\Book2.xlsx"
'値の貼り付け
Range("A2").PasteSpecial Paste:=xlPasteValues
'Book2ファイルの保存
ActiveWorkbook.Save
End sub