エクセル VBA 別ブックのシート移動について

質問

こんにちは。
いろいろと試してみたのですが、どうしてもうまく行かないので教えてください。

『ブックＡ』の、２枚目以降のシートすべてを
『ブックＢ』の、末尾に移動したいと思っています。

どうか、よろしくお願いします。
今後の勉強のためにも、簡単なコードの説明などつけて頂けると
なおうれしいです＾＾；

回答No.2

pauNed · ベストアンサー

こんにちは。
ブックＡ、ブックＢを開いておく事が前提です。

Sub sample() 'ブックＡ...などは実際のBook名に修正が必要
　　Dim wb As Workbook 'Workbook型変数準備
　　Dim n As Long 'シート数用変数
　　Dim i As Long 'Loopカウンタ用

　　Set wb = Workbooks("ブックＢ.xls") 'ブックＢを変数に格納
　　'WithやFor...NextステートメントはHelpで調べましょう
　　With Workbooks("ブックＡ.xls")
　　　　'シート数カウント
　　　　n = .Sheets.Count
　　　　'シート名格納用の変数
　　　　ReDim v(2 To n)
　　　　'２枚目からn枚目までのシートをLoop
　　　　For i = 2 To n
　　　　　　'変数にシート名を格納
　　　　　　v(i) = .Sheets(i).Name
　　　　Next i
　　　　'格納したシート名のSheetsをwbに移動
　　　　.Sheets(v).Move after:=wb.Sheets(wb.Sheets.Count)
　　End With
　　'SetしたObject型変数の後始末
　　Set wb = Nothing
End Sub

お礼

さっそくの回答ありがとうございます！！
やりたいこと、まさにそのものです＞＜
みなさん、本当にすごいですね～～～
私も、このコードを、ただ貼り付けるだけでなく
自分のものに出来るように、頑張って勉強します！
またどうしても解らないことが出てきたら、ぜひ教えてください。
今回は、このコードを使用させていただきます。
本当にありがとうございました。

回答No.4

Wendy02

こんばんは。

以下は、VBAの勉強のためにはならないと思いますが、私なりの考え方で作ってみました。
これは、人間が手作業ですることを、VBAに置き換えてみました。つまり、1つずつシートを選択するのではなく、複数選択して、まとめて移動します。

なお、厳密に、Worksheet と Sheet　は、指定するものが違ってきます。グラフシートなどがあると、それは、ワークシートではなくなってしまいますので、今回は、全て、Sheet という扱いにしました。

これは、以下の二つのブックとは関係のないブックに登録して、移動させることを目的にしたものです。標準モジュールが良いと思います。

'---------------------------------------------

Sub FileSheetCopy()
　Dim Wb1 As Workbook
　Dim Wb2 As Workbook
　Dim i As Integer

　'ユーザー設定
　Const CBK1 As String = "BOOK_A.XLS" '移動元
　Const CBK2 As String = "BOOK_B.XLS" '移動先

　'エラートラップ
　On Error GoTo ErrHandler　
　Set Wb1 = Workbooks(CBK1)
　Set Wb2 = Workbooks(CBK2)

　If Wb1.Sheets.Count = 1 Then MsgBox "移動元ブックのシートがひとつしかありません", vbInformation: Exit Sub
　Wb1.Activate
　'シートをまとめて選択
　For i = 2 To Wb1.Sheets.Count
　　If i = 2 Then
　　　Wb1.Sheets(i).Select
　　Else
　　　Wb1.Sheets(i).Select False
　　End If
　Next i
　'選択したシートを移動
　Wb1.Windows(1).SelectedSheets.Move after:=Wb2.Sheets(Wb2.Sheets.Count)

'エラー表示
ErrHandler:
　If Err.Number > 0 Then
　　If Err.Number = 9 Then
　　　MsgBox Err.Number & ": おそらくブックが開いていないと思います。", vbInformation
　　Else
　　　MsgBox Err.Number & " : " & Err.Description
　　End If
　End If

　Set Wb1 = Nothing: Set Wb2 = Nothing
End Sub

お礼

さっそくの回答ありがとうございます！！
すごく丁寧なコードで感動しました。
メッセージボックスまでつけて頂いて！！！
また、WorkSheetとSheetの違いなど、なるほどーーー！！！です！
本当にありがとうございます！！
頑張って、このコードを自力で書けるように解読します！！！
本当にありがとうございました。
またどうしても解らないことがでてきたら、ぜひ教えてください！

回答No.3

masa_019

No.1です。
コードを貼り付けるときに、
別な方を貼り付けたようです。
あまり変わらないけど、訂正します。

Sub Sample()
Dim wb1 As Workbook, wb2 As Workbook
Dim i As Integer

Set wb1 = Workbooks("ブックＡ.xls")
Set wb2 = Workbooks("ブックＢ.xls")

For i = wb1.Worksheets.Count To 2 Step -1
wb1.Worksheets(i).Move after:=wb2.Worksheets(wb2.Worksheets.Count)
Next

Set wb1 = Nothing
Set wb2 = Nothing
End Sub

お礼

再回答ありがとうございます！！
どこが違うのか、ぱっと見ではわかりません＾＾；
勉強させていただきます！！！
本当にありがとうございました。
またぜひよろしくお願いします！！

回答No.1

masa_019

こんにちは。

ブックＡのワークシートを後ろから順に
移動させるのがポイントでしょうか。
（前から移動させるとループが進んだ時に、
i番目のシートがなくなっているから）
後は特に難しいところは無いと思います。

Sub Sample()
Dim wb1 As Workbook, wb2 As Workbook
Dim i As Integer

Set wb1 = Workbooks("ブックＡ.xls")
Set wb2 = Workbooks("ブックＢ.xls")

For i = wb1.Worksheets.Count To 2 Step -1
Set sh = wb1.Worksheets(i)
sh.Move after:=wb2.Worksheets(wb2.Worksheets.Count)
Next
Set wb1 = Nothing
Set wb2 = Nothing
End Sub

お礼

まちがえて、補足にお礼を書いてしまいまして＾＾；
ごめんなさい。

補足

さっそくの回答、ありがとうございます！！
本当に勉強になります。
このコード、ただ貼り付けるだけでなく
読み取る勉強をして、自分のものに出来るように頑張りますね！！
またどうしても解らないことが出てきたら、ぜひ教えてください。
本当にありがとうございました。