【マクロ】ブイルックアップと新しいブック立ち上げ

質問

VBAを教えてください。
エクセルで、シート1にデータ、シート2には請求書フォームがあり、シート1のデータを反映させるようブイルックアップの関数を組んでいます。

この請求書フォームを、値貼り付けし別ファイルとして保存。(印刷はしない。)

という作業を繰り返すのですが、マクロでなんとか解決できないでしょうか。

よろしくお願いいたします。

回答No.6

kkkkkm · ベストアンサー

保存時に既に同じ名前のファイルがあるときに上書きするかどうかのメッセージが出た場合、キャンセルなどで保存しなかった場合エラーになりますから

NewBook.SaveAs ThisWorkbook.Path & "\NewFileName.xlsx", xlOpenXMLWorkbook

Set NewBook = Nothing

のところを以下のようにしておくとエラーを回避できます。

On Error Resume Next

NewBook.SaveAs ThisWorkbook.Path & "\NewFileName.xlsx", xlOpenXMLWorkbook

If Err.Number <> 0 Then
On Error GoTo 0
MsgBox "キャンセルされた、もしくはエラーで保存できませんでした。", vbInformation
End If
On Error GoTo 0

Set NewBook = Nothing

お礼

できました(T-T)神と呼ばせていただきます。ありがとうございました!!

Powered by GRATICA

回答No.5

kkkkkm

回答No.4の追加です。

With ThisWorkbook
.Sheets("Sheet2").Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
.Sheets("Sheet3").Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
.Sheets("Sheet4").Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
End With

上記より以下の方が早いかもしれません。

With ThisWorkbook
.Sheets(Array("Sheet2", "Sheet3", "Sheet4")).Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
End With

回答No.4

kkkkkm

> 新しく出来るファイルに追加で別の3つのシートも一緒に移せたら(ただ持っていくだけ)と思っているのですが、可能でしょうか。

Application.CutCopyMode = False

NewBook.SaveAs ThisWorkbook.Path & "\NewFileName.xlsx", xlOpenXMLWorkbook

のところに

With ThisWorkbook
.Sheets("Sheet2").Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
.Sheets("Sheet3").Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
.Sheets("Sheet4").Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
End With

上記を追加して以下のようにしてください。

Application.CutCopyMode = False

With ThisWorkbook
.Sheets("Sheet2").Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
.Sheets("Sheet3").Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
.Sheets("Sheet4").Copy after:=NewBook.Sheets(NewBook.Sheets.Count)
End With

NewBook.SaveAs ThisWorkbook.Path & "\NewFileName.xlsx", xlOpenXMLWorkbook

Sheet2,Sheet3,Sheet4は実際のシート名に変更してください。

回答No.3

kkkkkm

携帯で見ていてコードはコピペできないので打ち込んでいるとかでしたら

NewFileName.xlsxの前に\がある

の\が逆スラッシュに見えると思いますが半角の￥ですので、とりあえず念のために。

補足

神...!!すごい!!作成されたファイルにエラーが出てきましたが何ら問題なく、希望するものができました！
ちなみに思いつきで大変恐縮なのですが、新しく出来るファイルに追加で別の3つのシートも一緒に移せたら(ただ持っていくだけ)と思っているのですが、可能でしょうか。。

回答No.2

kkkkkm

回答No.1で値貼り付けの結果がおかしい場合は

.UsedRange.Copy

のところを

ThisWorkbook.Sheets("シート2").UsedRange.Copy

に変更してみてください。

回答No.1

kkkkkm

以下で試してみてください。

シート2は実際のシート名に
NewFileName.xlsxは保存したいファイル名に
(NewFileName.xlsxの前に\があるのはそのままで)
それぞれ変更してください。

Sub Test()
Dim NewBook As Workbook

ThisWorkbook.Sheets("シート2").Copy
Set NewBook = ActiveWorkbook

With NewBook.Sheets("シート2")
.UsedRange.Copy
.UsedRange.PasteSpecial Paste:=xlPasteValues
.Range("A1").Select
End With

Application.CutCopyMode = False

NewBook.SaveAs ThisWorkbook.Path & "\NewFileName.xlsx", xlOpenXMLWorkbook

Set NewBook = Nothing

End Sub