『別のエクセルへデータを転記』（エクセル初心者）
別のエクセルへデータを移動させたいのですが
上手くいきません。
実行しても、エラーにはならないのですが、転記もできておらず
困っています。
エクセル『受付』のシート『受付フォーム』の内容を
エクセル『台帳』のシート『一覧』へコピーしたいのですが
マクロは『受付フォーム』のコマンドボタンに設定しています
以下がコードです。
Dim Xbook As Workbook
Dim Abook As String, Bbook As String
Dim Bsearch As Boolean
Dim ConA As Integer
'エクセル「台帳」を開いているか確認
If MsgBox("台帳を開いていますか？", vbYesNo, "データを移動します") = vbYes Then
'受付フォームにある件数をカウントする
ConA = WorksheetFunction.countA(Range("B3:B53"))
Application.ScreenUpdating = False
Abook = "台帳.xlsx"
Bbook = "受付.xlsx"
Bsearch = False
For Each Xbook In Workbooks
If Xbook.Name = Abook Then
Bsearch = True
Exit For
End If
Next
If Bserach Then
'受付フォームのB3セルを起点にカウントした分の行数をコピー
'B3からY3に1件目のデータがあり、件数分コピー範囲を拡大
Workbooks("Bbook").Activate
Sheets("受付フォーム").Select
Range(Cells(3, 2), Cells(2 + ConA, 25)).Select
Selection.Copy
'台帳の一覧の最終行にコピーした内容を貼り付け（xlDownに書き換えても反応なし）
Workbooks("Abook").Activate
Sheets("一覧").Select
Range("B100000").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
End If
Application.CutCopyMode = False
Else
MsgBox "一覧を開いて実行してください", vbCritical
End If
Application.ScreenUpdating = True
End Sub
＜ 使用 Excel：Excel2016、使用 OS：Windows11 ＞
>エラーにはならないのですが ほんとですか？
Workbooks("Bbook").Activate
とか、
Workbooks("Abook").Activate
で
インデックスが有効範囲にありません。
というエラーになりませんか？
Workbooks("Bbook").Activate
Workbooks(Bbook).Activate
の違いを意識してください。
（ ´・ω・`） 2025/07/04(金) 16:21:04
ご自身で処理がうまくいかない理由にたどり着けないなら 一部ではなくコードを全文そのままコピペすることをお勧めします。 Sub ~ End Subまでということです。
既にご指摘のある通り、変数名を文字列として扱っているのでエラーになるはずです。 （デボラ） 2025/07/04(金) 18:41:54
因みにOn Error Resume Nextと記述しているなら即刻削除してください。 訳もわからずにとりあえずで記載するものではありません。 （デボラ） 2025/07/04(金) 18:44:21
■１
VBAの世界では基本的ブックやシート、セルなど（オブジェクトと言います）は、きちんと指定すれば、いちいちアクティブにしたり選択したりする必要はありません。
また、【標準モジュール】でシートの指定を省略した場合、ActiveSheetを指定したものとみなされるルールです。
したがって、可読性向上の観点や誤ったものを処理対象にしてしまわないようにするために、対象のオブジェクトを指定する癖をつけるとよいと思います。
■２
提示されたコードは【インデント】がついていません。
インデントの有無は、ＶＢＡの実行上に影響をあたえるものではありませんが、適切なインデントをつけることにより全体の構造が把握しやすくなり、デバッグ作業の効率アップに寄与するとおもいますので、こだわりがなければインデントを付けるようにするとよいとおもいます。
■３
既にみなさんから指摘があることですが、あれっおかしいぞ？となったら、まずは【ステップ実行】で自己検証をされるとよいです。
■４
ということを踏まえて、私なりに提示のコードを整理してみましたので提示しておきます。
Sub 整理()
Dim Xbook As Workbook
Dim Bsearch As Boolean
Stop 'ブレークポイントの代わり
If MsgBox("台帳を開いていますか？", vbYesNo, "データを移動します") = vbYes Then
Application.ScreenUpdating = False
Bsearch = False
For Each Xbook In Workbooks
If Xbook.Name = "台帳.xlsx" Then
Bsearch = True
Exit For
End If
Next
If Bsearch = True Then
With Workbooks("受付.xlsx").Sheets("受付フォーム")
.Range("B2:Y" & 2 + WorksheetFunction.CountA(.Range("B3:B53"))).Copy
Workbooks("台帳.xlsx").Sheets("一覧").Range("B100000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
Else
MsgBox "台帳が開かれていません！" & vbLf & "処理をキャンセルしました", vbCritical
End If
Application.ScreenUpdating = True
Else
MsgBox "台帳を開いてから再度実行してください", vbCritical
End If
End Sub
（もこな２ ） 2025/07/05(土) 09:35:02
既に適切な回答が寄せられています。追加でひとこと。
エラーにならない理由は、 If Bserach Then と Bsearchをタイプミスしているため、 その変数はTrueにはなりえず、それ以下End Ifまでが実行されていないことが理由。 対応策は、モジュールの先頭に Option Explicit を入れておくことです。 こうすれば、今回のような未宣言の変数はエラー（変数が定義されていませんというコンパイルエラー）が出て、 しかも場所を特定してくれますから、原因が直ぐに判明します。 http://officetanaka.net/excel/vba/beginner/06.htm を参照してください。
また、そこに記載されているように、以下のようにすることで、 自動的にOption Explicitを挿入させることができます。 VBEの 「ツール」 − 「オプション」 − 「編集」 で 「変数の宣言を強制する」にチェックを入れてください。 モジュールを作成した時点で、Option Explicitが自動的に挿入されるので、手間が省けます。 一度だけチェックを入れておきさえすれば、それ以降その設定は永続的に適用されます。 （ほとんどの人はこうしているはずです。やっていない人は即刻取り入れることを推奨）
■ そもそもそのコードはどこに書いてあるのでしょうか。 受付ブックであれば、ブック名は Bbook = "受付.xlsm"であるべきです。 また、コマンドボタンがフォームのものなのか、ActiveXコントロールのものなのかによっても違ってきます。 後者であれば、Sheetモジュールに書いているはずで、 その場合、ワークシートを指定していないRangeオブジェクトは、受付シートと見なされるので注意が必要です。 （アクティブブックのアクティブシートが何であるかとは無関係に決まります。） イベントプロシージャを使わない簡単なことをするなら、フォームコントロールのボタンを推奨します。
# プロシージャの名前も省略せずに最初から書くべきでしょう。 (省略しなければどちらのボタンなのか直ぐに分かります。) （xyz） 2025/07/05(土) 10:32:09
テスト環境が
Option Explicit
Private Sub wff()
zddmk
End Sub
Private Sub zddmk(Optional ByVal Sflg As Boolean = False)
Dim FS As Object
Dim ps$, fNm(), i&, j&, k&, wb
ps = ThisWorkbook.Path
fNm = Array("台帳.xlsx", "受付.xlsx")
Set FS = CreateObject("Scripting.FileSystemObject")
For i = 0 To 1
If FS.FileExists(ps & "\" & fNm(i)) Then
FS.DeleteFile ps & "\" & fNm(i)
End If
Next
If Sflg Then Exit Sub
For i = 0 To 1
If Not FS.FileExists(ps & "\" & fNm(i)) Then
Set wb = Workbooks.Add
If fNm(i) = "受付.xlsx" Then
With wb.Worksheets(1)
.Name = "受付フォーム"
For j = 2 To 25
.Cells(2, j) = "Field" & Format(j - 1, "00")
Next
For j = 3 To 53
.Cells(j, 2) = j - 2 + 10000
Next
.Range(.Cells(3, 3), .Cells(53, 25)).Formula = "=ADDRESS(ROW(),COLUMN(),4)"
End With
End If
If fNm(i) = "台帳.xlsx" Then
With wb.Worksheets(1)
.Name = "一覧"
For j = 2 To 25
.Cells(2, j) = "Field" & Format(j, "00")
Next
End With
End If
End If
wb.SaveAs ps & "\" & fNm(i), 51
wb.Close False
Next
End Sub
が前程で 処理コードは下記の通りです[あくまで一例ですぅA^^;]
Sub Watasi_Nara_Kousuru_KamoV000()
If EnvChec Then
MoveWrite
End If
End Sub
Private Sub MoveWrite()
Dim FS As Object
Dim ps As String
Dim fNm() As Variant
Dim cN As Long
Dim wbS, wbD, WsS, WsD, r
Dim i As Long
Dim Lr As Long
Dim Wflg As Boolean
ps = ThisWorkbook.Path
fNm = Array("台帳.xlsx", "受付.xlsx")
For i = 0 To 1
Select Case i
Case 0
Set wbD = Workbooks.Open(ps & "\" & fNm(i))
Set WsD = wbD.Worksheets("一覧")
Case 1
Set wbS = Workbooks.Open(ps & "\" & fNm(i))
Set WsS = wbS.Worksheets("受付フォーム")
End Select
Next
With WsS
Lr = .Cells(Rows.Count, 2).End(xlUp).Row + 1
Set r = .Range(.Cells(3, 2), .Cells(Lr, "Y"))
End With
With WsD
Lr = .Cells(Rows.Count, 2).End(xlUp).Row + 1
If Lr < Rows.Count - 500000 Then
r.Copy .Cells(Lr, 2)
wbD.Close True
Else
wbD.Close False
Wflg = True
End If
End With
wbS.Close False
Erase fNm
If Wflg Then MsgBox "書込み出来ませんでした"
End Sub
Private Function EnvChec() As Boolean
EnvChec = False
Dim FS As Object
Dim ps As String
Dim fNm() As Variant
Dim cN As Long
Dim wb
Dim i As Long
Set FS = CreateObject("Scripting.FileSystemObject")
ps = ThisWorkbook.Path
fNm = Array("台帳.xlsx", "受付.xlsx")
For i = 0 To 1
If FS.FileExists(ps & "\" & fNm(i)) Then
cN = cN + 1
End If
Next
If cN <> 2 Then
MsgBox "ブックが存在しない可能性が有ります"
Erase fNm
Exit Function
End If
EnvChec = True
Erase fNm
End Function
（隠居Z） 2025/07/05(土) 14:55:04
まず、台帳.xlsxが開いているかユーザーに問い合わせてから、さらにそれが本当なのか機械的に調べていますが、どうせ調べるならユーザーへの問い合わせは不要ではないでしょうか？
また、受付フォームをマクロブックにするならば、ThisWorkbookで表現可能です。
■６
ということを踏まえると、以下のようなコードでも目的を達成することができるとおもいます。
興味があればステップ実行で研究してみてください。
Sub 整理改()
Dim dstWB As Workbook
Stop 'ブレークポイントの代わり
On Error Resume Next
Set dstWB = Workbooks("台帳.xlsx")
On Error GoTo 0
If dstWB Is Nothing Then
MsgBox "台帳を開いてから再度実行してください", vbCritical
Else
With ThisWorkbook.Sheets("受付フォーム")
.Range("B2:Y" & 2 + WorksheetFunction.CountA(.Range("B3:B53"))).Copy
dstWB.Sheets("一覧").Range("B100000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
End If
End Sub
（もこな２） 2025/07/06(日) 22:37:11
（エクセル名をシート名が変わっています。ややこしくてすみません…）
Option Explicit
Private Sub CommandButton1_Click()
'客注台帳へデータを転記
Dim Xbook As Workbook
Dim Bsearch As Boolean
'エクセル「客注リスト」を開いているか確認
If MsgBox("客注リストを開いていますか？", vbYesNo, "データを移動します") = vbYes Then
Application.ScreenUpdating = False
Bsearch = False
For Each Xbook In Workbooks
If Xbook.Name = "客注リスト.xlsx" Then
Bsearch = True
Exit For
End If
Next
If Bsearch = True Then
With Workbooks("客注受付フォーム.xlsx").Sheets("当日受付リスト")
.Range("B2:Y" & 2 + WorksheetFunction.countA(.Range("B3:B53"))).Copy
Workbooks("客注リスト.xlsx").Sheets("予約一覧").Range("B100000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
Else
MsgBox "客注リストが開かれていません！" & vbLf & "処理をキャンセルしました", vbCritical
End If
Application.ScreenUpdating = True
Else
MsgBox "客注リストを開いて実行してください", vbCritical
End If
End Sub
（エクセル初心者） 2025/07/08(火) 17:44:21
(1)
Private Sub CommandButton1_Click()
の次の行に
Stop
と挿入してください。
そして実行すると、そこで止まるはずです。
(2)
F8キーを押すと、一行ずつ実行していきます。
想定した処理がされているかを確認してください。
つまり、
If Xbook.Name = "客注リスト.xlsx" Then
Bsearch = True
が実行されて BsearchがTrueになり、
If Bsearch = True Then
With Workbooks("客注受付フォーム.xlsx").Sheets("当日受付リスト")
.Range("B2:Y" & 2 + WorksheetFunction.CountA(.Range("B3:B53"))).Copy
Workbooks("客注リスト.xlsx").Sheets("予約一覧").Range("B100000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
が実行されているか確認して下さい。
結果を教えてください。
>countA関数が小文字になっています の件は別途触れます。 今は上記のことに専念してください。
（xyz） 2025/07/08(火) 18:17:17
If MsgBox("客注リストを開いていますか？", vbYesNo, "データを移動します") = vbYes Then
↓
メッセージが出る → はい
↓
Application.ScreenUpdating = False
Bsearch = False
For Each Xbook In Workbooks
If Xbook.Name = "客注リスト.xlsx" Then
End If
Next
If Xbook.Name = "客注リスト.xlsx" Then
End If
Next
If Bsearch = True Then
Else
MsgBox "客注リストが開かれていません！" & vbLf & "処理をキャンセルしました", vbCritical
開かれていませんのコメントが表示
End If
Application.ScreenUpdating = True
End If
End Sub
という順に処理されました。
『If Xbook.Name = "客注リスト.xlsx" Then
End If
Next』
この処理が2回繰り返されてるということは探せてないということでしょうか…
（エクセル初心者） 2025/07/08(火) 18:30:34
(1)
念のため、
If Xbook.Name = "客注リスト.xlsx" Then
を
If LCase(Xbook.Name) = "客注リスト.xlsx" Then
に変更して、同じことを実行して、一致するかどうか自分で確認して下さい。
(2)また、
With Workbooks("客注受付フォーム.xlsx").Sheets("当日受付リスト")
.Range("B2:Y" & 2 + WorksheetFunction.CountA(.Range("B3:B53"))).Copy
Workbooks("客注リスト.xlsx").Sheets("予約一覧").Range("B100000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
に登場するブックの名前、シートの名前は正しいのですか。確認して下さい。
(3)
コードが書かれているのは、どのブックのシートモジュールなんですか？
回答してください。
（xyz） 2025/07/08(火) 18:41:03
拡張子は大文字でも小文字でも機能はしますが、 その比較方法では、大文字の拡張子とは不一致になります。 そこでXBOOK.Nameをいったん小文字に変換したうえで比較しています。
もこな２さんが既に指摘されたように、 ひとつづつ名前を突き合せなくても、直接、ブックの有無を確認する方法があります。 2025/07/06(日) 22:37:11 の■６を参照してください。
【積み残し案件】
> countA関数が小文字になっていますが これはあなたが、countAという変数を以前に宣言したはずです。 それをExcelが覚えているのです。 もう一度、 Dim CountA As Long (CountAと頭が大文字になっていることに注意) と変数を宣言しなおして、そのあとで、すぐに削除して下さい。 そうすれば、 WorksheetFunction.CountA と表示されるはずです。
返事はありませんが、とりあえず私はここで。
（xyz） 2025/07/08(火) 19:37:06
■７
＞この処理が2回繰り返されてるということは探せてないということでしょうか…
そこは、ループ処理と呼ばれる部分で"正しく"動作したからこそ複数回実行されています。
すなわち
For Each Xbook In Workbooks
If Xbook.Name = "客注リスト.xlsx" Then
Bsearch = True
Exit For
End If
Next
↑は↓のように命令してます。
【ブックのあつまり】から、ひとつずつ取り出して【Xbook】に格納しなさい（ループ処理開始）
もしも、【Xbook】に格納したブックの名前が"客注リスト.xlsx"ならば
【Bsearch】を真にしなさい
以降のループ処理はせず、ここで抜けなさい（ループ処理をやめなさい）
もしもの話は、おしまいです
【Xbook】に次のブックを格納して、ループの始めから処理しなさい
なので、開いているブックを順番にみていき、条件にあうか判定してるだけです。
（探すという表現もできなくはないですが、少し気になりましたのでコメントします）
なお、【ステップ実行】を行って実行順を確認するのも重要ですが、それぞれのタイミングで変数に何が格納されているか確認することも同じくらい重要です。
今回は、オブジェクト型の変数がありますから、【イミディエイトウィンドウ】や【ローカルウィンドウ】を使う必要があります。
スマホからなので、参考リンクは省略しますが、余力があれば調べてみてください。
（もこな２ ） 2025/07/09(水) 09:39:02
昨日からの続きです。
> 『If Xbook.Name = "客注リスト.xlsx" Then > End If > Next』 > この処理が2回繰り返されてるということは探せてないということでしょうか…
そういうことになりますね。
・客注リスト.xlsxというのが開かれているとしたら、なぜ一致しないのか。 ・一致するはずの Xbook.Name は実際にどんな文字列になっているんだろうか、 と調べるのがデバッグ（コードの間違い修正。虫取りの意）ということです。
変数の値を調べる方法は知っていますか。 (1)ステップ実行の最中にイミディエイトウインドウに ?Xbook.Name を入れれば文字列が表示されるので内容がわかります。 ?Len(Xbook.Name) などとして文字数を調べることもあります。 場合によっては、目に見えない半角スペースが尻尾についていたなどとケースもありえます（今回はあり得ないが） (2)その他、場合によってはローカルウインドウでオブジェクト変数(XBOOK等）のプロパティを見るとか (3)単純な変数なら、そのうえにカーソルを持っていくと値がポップアップされるとか デバッグの基本的な方法をマスターすることを推奨します。 完全なコードしか書かない、と言う人はいません。誰しも日常的にデバッグをしています。必須のスキルです。
# ありがちなのは、"客注リスト .xlsx"のように余計なspaceが入っていたなどというものです。 # 拡張子を小文字に変換したうえで比較するのも、対応策のひとつです。
■
開かれているブックは二つだけであれば、Workbooks("客注受付フォーム.xlsx")にマクロが書かれているんですね？
既に指摘していますが、拡張子を.xlsmにしないとエラーになります。一度でも保存されていれば.xlsmになっているはず。
ここもThisWorkbookと書けば、名前の間違いを避けられるし、ブックの意味が明確になります。（もこな２さんから指摘がありました）
# つらつら書いていたら発言が衝突しました。重なっていますが、もう修文しません。 （xyz） 2025/07/09(水) 10:03:11
拡張子が違っていました。マクロブックは「xlsm」になるんですね！
おかげさまで無事に処理が完了しました。
本当にありがとうございます！
（エクセル初心者） 2025/07/10(木) 16:42:43
マクロブックは 客注受付フォーム.xlsm の話ですよね。
客注リスト.xlsx はその拡張子でよいはずです。 それが不一致になっていた理由は結局何だったのですか？ こちらにも伝えて下さい。 （xyz） 2025/07/10(木) 16:48:17
了解しました。返答有難うございました。
# 質問者と閲覧者のお互いの経験を情報交換することがこちらの質問掲示板の目的の一つと思っています。 （xyz） 2025/07/10(木) 19:15:27
■８
＞どちらもマクロ有効ブックで保存していたので、どちらもxlsmに変えたら〜
もしかして、xls形式じゃないか？と思わなくはなかったですが、そちらでしたか・・・
既に学習されたように、文字列の比較は大文字小文字や全角半角を含めて、１文字でも違えば不一致になりますので注意が必要です。
また、結局最後まで答えていただけませんでしたが、問題のマクロはどのブックに書いてあったのでしょうか。
今回の処理だけ考えれば、【当日受付リスト】シートがあるブックがマクロブックであれば事足りるので、【予約一覧】シートがあるブックはマクロ付きブックにする必要は無いです。（既に指摘されていますが一応）
■９
結局、ステップ実行しながら、それぞれのタイミングで変数に何が格納されているか確認されたのかわかりませんが、どうしてもステップ実行したくないということならば、↓のようなコードを書いてチェックするという方法もありました。参考に提示します。
Sub ブック名調べ()
Dim i As Long
For i = 1 To Workbooks.Count
Debug.Print i & "番目のブック名【" & Workbooks(i).Name & "】"
Debug.Print "【客注リスト.xlsx】との比較結果→" & ("客注リスト.xlsx" = LCase(Workbooks(i).Name))
Debug.Print ""
Next i
End Sub
■10
.Range("B2:Y" & 2 + WorksheetFunction.countA(.Range("B3:B53"))).Copy
.Range("B2:Y53"))).Copy
↑について後者でも事足りたりしませんか？
（ブランクセルを値貼り付けしたところでブランクセルなので、C〜Y列にごみデータがなければそのまま貼り付けても問題ないのでは？という趣旨です）
■11
今回は違うようですが、あらかじめ拡張子が特定できないという場合には、単純比較では解決できません。
この点についてワイルドカードを使って解決するならばLike演算子を使う必要があります。
■12
踏まえて、ファイル名（ブック名）で指定することにこだわりつつ、拡張子がわからないという話ならば↓のようなアプローチもあると思います。
Sub 研究用2()
Dim srcWB As Workbook, dstWB As Workbook, WB As Workbook
Stop 'ブレークポイントの代わり
'▼開いているブックを巡回して調べる
For Each WB In Workbooks
'▼ワイルドカードを使ってLike演算子で文字列比較して、条件に合致したら変数にセットする
If LCase(WB.Name) Like "客注受付フォーム.xls*" Then Set srcWB = WB
If LCase(WB.Name) Like "客注リスト.xls*" Then Set dstWB = WB
Next
'▼処理に進むか判定
Select Case True
Case srcWB Is Nothing And dstWB Is Nothing
MsgBox "「客注受付フォーム」及び「客注リスト」が開いていないので処理できません"
Case srcWB Is Nothing
MsgBox "「客注受付フォーム」が開いていないので処理できません"
Case dstWB Is Nothing
MsgBox "「客注リスト」が開いていないので処理できません"
Case Else
'▼両ブックが開いているときだけ処理する
srcWB.Sheets("当日受付リスト").Range("B2:Y53").Copy
dstWB.Sheets("予約一覧").Range("B100000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Select
End Sub
（もこな２ ） 2025/07/12(土) 08:59:17
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.