ＶＢＡ初心者

質問

いつも大変に参考にさせて頂いております。

Sheet1 に値を入力し、Sheet3には表がありSheet1の計算結果を関数にて表示するようにしております。
ＶＢＡにて、Sheet3の内容のみを新しいExcelファイルとして保存したいのですが、どなたか分かるかたご教示頂けないでしょうか。
条件は
Sheetは複数ある（５シートほど）
値のみ貼付け　としてから、関数の無い状態で保存したい。

こちら分かる方はご教示頂けませんでしょうか

回答No.6

kkkkkm · ベストアンサー

回答No.3は「コピーしたいシートのあるブック」の標準モジュールにコードを記載して実行することが前提です。

回答No.5は回答No.3と違い「コピーしたいシートのあるブック"以外"」の標準モジュールにコードを記載して実行することが前提です。

また安全を期して
回答No.5の

Worksheets("Sheet1").Delete
は
NewWb.Sheets("Sheet1").Delete
に変更してください。

お礼

理解するのに時間がかかりお礼が遅くなり申し訳ありません。またこういった質問は期限が迫っている事もあり複数質問を上げていくかもしれません。その時に目に触れましたら　ご回答頂けると幸いです。

Powered by GRATICA

回答No.5

kkkkkm

> 複数ファイルを１つのファイルとして保存

複数のシートではなく複数ファイルだとしたら以下で試してみてください。

Sub Test3()
Dim WbName As String, NewWb As Workbook, Ws As Worksheet
Dim NewWbName As String
Dim tmp As Long

tmp = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1

NewWbName = "新規ブック.xlsx"
Set NewWb = Workbooks.Add

Call mCopyPaste3("C:\Ok\Test.xlsx", "Sheet3", NewWb)
'以下必要なだけ上の1行のブック名とコピーしたいシート名だけを変えて下に追加する
'Call mCopyPaste3("C:\Ok\Test2.xlsx", "Sheet5", NewWb)

'これより上に追加
Application.DisplayAlerts = False
Worksheets("Sheet1").Delete
Application.DisplayAlerts = True
NewWb.SaveAs ThisWorkbook.Path & "\" & NewWbName

Application.SheetsInNewWorkbook = tmp

Set NewWb = Nothing

End Sub

Function mCopyPaste3(ByRef WbName As String, ByVal SheetName As String, ByRef NewWb As Workbook)
Dim Wb As Workbook, Ws As Worksheet

Set Wb = Workbooks.Open(WbName)

Wb.Sheets(SheetName).Copy After:=NewWb.Sheets(NewWb.Sheets.Count)

Set Ws = NewWb.ActiveSheet

Ws.UsedRange.Copy
Ws.UsedRange.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Ws.UsedRange.Item(1).Select

Wb.Close SaveChanges:=False

Set Ws = Nothing
Set Wb = Nothing

End Function

回答No.4

kkkkkm

No.3は
> 複数ファイルを１つのファイル

ではなく複数のシートを1つのファイルにと捉えましたが、複数のファイルでしたら違った動作になります。

お礼

質問の書き方が問題でした。
質問の通りの回答をいただいたのに申し訳ないです。

回答No.3

kkkkkm

> こちらの数式でSheet3以外のシートを一つのファイルとして保存できるでしょうか。

Sheet3だけです。
質問は
> Sheet3の内容のみを新しいExcelファイルとして保存したい
でしたので、1シート1ファイルと考えます。

> 複数ファイルを１つのファイルとして保存できると有難いです。

以下のコードでシート名やブック名を変更して試してみてください。

Sub Test()
Dim ThisWb As Workbook, Wb As Workbook
Dim NewWbName As String

Set ThisWb = ThisWorkbook

NewWbName = "新規ブック.xlsx"

ThisWb.Sheets("Sheet3").Copy

Set Wb = ActiveWorkbook

Call mCopyPaste(Wb)

ThisWb.Sheets("Sheet4").Copy After:=Wb.Sheets(Wb.Sheets.Count)
Call mCopyPaste(Wb)
'以下必要なだけ上の2行のシート名だけを変えて下に追加する
'以下のように
'ThisWb.Sheets("Sheet5").Copy After:=Wb.Sheets(Wb.Sheets.Count)
'Call mCopyPaste(Wb)
'
'これより上に追加
Wb.SaveAs ThisWorkbook.Path & "\" & NewWbName

Set Wb = Nothing

End Sub

Function mCopyPaste(ByRef Wb As Workbook)
Dim Ws As Worksheet
Set Ws = Wb.ActiveSheet

Ws.UsedRange.Copy
Ws.UsedRange.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Ws.UsedRange.Item(1).Select

Set Ws = Nothing

End Function

お礼

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

Powered by GRATICA

回答No.2

kkkkkm

とりあえずSheet3を新規ブック.xlsxという名前で保存するコードです。
別のシートも同じようにしてください。

Sub Test()
Dim Wb As Workbook, Ws As Worksheet
Dim NewWbName As String

NewWbName = "新規ブック.xlsx"

Sheets("Sheet3").Copy

Set Wb = ActiveWorkbook
Set Ws = Wb.ActiveSheet

Ws.UsedRange.Copy
Ws.UsedRange.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Ws.UsedRange.Item(1).Select

Wb.SaveAs ThisWorkbook.Path & "\" & NewWbName

Set Ws = Nothing
Set Wb = Nothing
End Sub

補足

早速のご回答をいただきありがとうございます。
試す前に申し訳ないのですが、こちらの数式でSheet3以外のシートを一つのファイルとして保存できるでしょうか。
各シートごとに１ファイルずつ作られるよりも、複数ファイルを１つのファイルとして保存できると有難いです。

回答No.1

sknbsknb2

下記の操作をマクロ記録して、必要な時にマクロを実行すればいいのでは。

(1)該当部分をコピーして値のみ貼り付け
(2)Sheet3以外のシートを削除
(3)適当な名前をつけて保存

お礼

ご回答ありがとうございます。
適当な名前ですと、その後の利用が難しいためマクロの保存のみでは賄えない所もありそうでした。
ただ、マクロの保存は便利ですよね。参考にさせて頂いて居ます。

また見掛けて頂いた際は、ご回答頂けると幸いです。