『別のエクセルへデータを転記』（エクセル初心者）
別のエクセルへデータを移動させたいのですが
上手くいきません。
実行しても、エラーにはならないのですが、転記もできておらず
困っています。
エクセル『受付』のシート『受付フォーム』の内容を
エクセル『台帳』のシート『一覧』へコピーしたいのですが
マクロは『受付フォーム』のコマンドボタンに設定しています
以下がコードです。
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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.