Bookへファイルを飛ばす！

質問

Bookへファイルを飛ばす！
エクセルVBAで
"A"BooKと"B"Bookと"C"Bookがあります！
3つのBookにそれぞれSheetを飛ばしたいです。

例えば、 CommandButton1_Click()すると
Sheet1は"A"Bookへ
Sheet2は"B"Bookへ
Sheet３は"C"Bookへ
とそれぞれの場所に行かせたいのですが…
すいません教えて下さい

１つだけ飛ばすなら分かるのですが！

回答No.3

keithin · ベストアンサー

つまりシート１２３をそれぞれブックにコピーしたかったんじゃなくて，各シートを別のファイル分けて保存したかったって事ですかね。

いずれにしても「１つも３つも同じ」というのは変わりませんので，基本形としては
dim s as worksheets
for each s in worksheets
s.copy
activeworkbook.saveas filename:=format(now, "yymmddhhmmss") & activesheet.name & ".xls"
activeworkbook.close false
next
とかなんとかの具合です。

「ファイルが既にあったらどうしたい」とか「保存ファイル名の具体的な付け方」とか「作業対象シートの具体的なチョイス」とかそういった細々した処理については，ご質問で掲示された今のマクロで既にあなたのアタマの中で出来ていることですから，回答者が変にこねくるより，折角あなたがご自分で考えた作成方針に従って作成してください。

お礼

ありがとうございました。
時間がかかりましたが何とか自分で飲み込むことができました！

回答No.2

keithin

例：
private sub commandbutton1_click()
thisworkbook.worksheets("Sheet1").copy before:=workbooks("BookA.xls").worksheets(1)
thisworkbook.worksheets("Sheet2").copy before:=workbooks("BookB.xls").worksheets(1)
thisworkbook.worksheets("Sheet3").copy before:=workbooks("BookC.xls").worksheets(1)
end sub

＃コマンドボタンと「それぞれのシート」の関係が不明です。
＃いずれにせよ１つも３つも全く変わりません。

補足

ありがとうございます
例えばNo1さんの補足にも書いた
記述の時にはどのように
変化させれば良いのでしょうか＞？

すいません！教えてください

回答No.1

bin-chan

「飛ばす」って何？データを送り込むこと？

それはコピーなの？シートの移動なの？
移動として、持って行く先に重複するシート名があったらどうするの？

> １つだけ飛ばすなら分かるのですが！

CommandButton1_Click()で、

１）"A"Bookを開き、ThisWorkBook.Worksheets("Sheet1")からコピー・移動等の操作を行う。
２）"A"Bookを閉じる。
３）"B"Bookを開き、ThisWorkBook.Worksheets("Sheet2")からコピー・移動等の操作を行う。
４）"B"Bookを閉じる。
５）"C"Bookを開き、ThisWorkBook.Worksheets("Sheet3")からコピー・移動等の操作を行う。
６）"C"Bookを閉じる。

で実現できそうです。

補足

早速の回答ありがとうございます
Private Sub CommandButton1_Click()
Dim FileName As String
Dim FileExt As String
Dim BkName As String
Dim OldWkbook As Workbook
Dim NewWkbook As Workbook
Dim ws As Worksheet
Application.DisplayAlerts = False
Set OldWkbook = ActiveWorkbook
'
'ファイル名を取得
BkName = OldWkbook.Sheets(StName1).Range("F5").Value
FileName = BkName & Format(Now, "mm-dd") & ".XLS"
'
FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName)
If FileName = "" Then
Exit Sub
Else
If Right(FileName, 4) <> ".XLS" Then
MsgBox "ファイル名が異常です。"
Exit Sub
End If
End If
'

OldWkbook.Sheets(Array(StName1)).Copy

Set NewWkbook = ActiveWorkbook

For Each ws In NewWkbook.Worksheets
ws.Unprotect Password:="1111" '←シートに保護を解除

ws.Protect Password:="1111" '←シートに保護を掛ける
Next ws
FileName = "D:A\" & FileName
If Dir(FileName) <> "" Then
'##ファイルが既に存在する
If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then
NewWkbook.Close savechanges:=False
'##保存せずに終了
Exit Sub
End If
'##指定ファイル置き換え保存
NewWkbook.SaveAs FileName:=FileName
Else
'##ファイルを新規保存
NewWkbook.SaveAs FileName:=FileName
End If
'
NewWkbook.Close savechanges:=False
Application.DisplayAlerts = True

MsgBox " 記録します！"
Unload Me

Else
MsgBox " キャンセル!！"
１つならこのように
出来るのですが２つ以上なら
どのように変えれば良いのか困っています！