VBAでダイアログボックスから開いたExcelファイルと別のファイルのA列を比較して、同じならB列C列の値をコピペしたいです。

前提・実現したいこと
VBA を使い、2つのブックを比較してデータの転機をしたいです。
その際、比較する先のファイルをダイアログボックスから開くようにしています。

データの比較について説明すると、まずA列の数字を2つのブック間で比較をします。
その後、同じだった場合、比較する先のファイル(fn1)のB列、C列の値をもとのブック（Wb１）に張り付けるというものです。
例）If　Wb１.Cells（１，１）.Value=fn1.Cells(1,5) Then
Wb１.Cells(２,1)=fn1.Cells(2,５)
Wb１.Cells(3,1)=fn1.Cells(3,5) 　というような感じ
これをsheet１，２・・・およびA列で繰り返していきたいです。

発生している問題・エラーメッセージ

ダイアログボックスからExcelファイルを開くところまでは動くのですが、If文の部分から先で止まってしまいます。
主にオブジェクトについてのエラーコードが出てしまう状況です。

エラーメッセージ

該当のソースコード

Sub sisaku1()
'
' sisaku1 Macro

'
'
    Dim wb1
    Set wb1 = ThisWorkbook//マクロを動かしているブック、貼り付け先
    
    
    Dim fn As String
    fn = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xlsx")
    
    
    If fn <> "False" Then
        Workbooks.Open fn
        fn1 = Dir(fn)　//比較する先
        MsgBox fn1 //開いたファイル名を表示
        
        
        
        For Each objSheet In ThisWorkbook.Worksheets　//貼り付け先のすべてのシートを参照
    
            Dim j As Integer　//比較する先のファイルの行
            Dim i As Integer //貼り付け先のファイルの行
    
            For i = 1 To 1000
                For j = 1 To 1000
                    If Wb1.Worksheets.Cells(j, 1).Value = 
 Workbooks(fn1).Worksheets("Sheet1").Cells(i, 1).Value Then //それぞれのブックのセルの値を比較していく

                        Wb1.Worksheets.Cells(j, 2).Value 
= Workbooks(fn1).Worksheets("Sheet1").Cells(i, 2).Value

                        Wb1.Worksheets.Cells(j, 3).Value 
= Workbooks(fn1).Worksheets("Sheet1").Cells(i, 3).Value
                
                    End If
                Next j
            Next i
        Next
    Else
        MsgBox "エラーです"　　　//ファイルを選ばなかったときのエラー文
    End If




End Sub

試したこと

補足情報（FW/ツールのバージョンなど）

pig_vba

2023/01/31 02:54

エラーメッセージが出ているならその内容、エラー発生時にデバッグ押すと黄色で反転表示される行を明記するとより迅速な回答が得られやすくなります。

pig_vba

2023/01/31 02:56

真っ先に目につくのは If Wb1.Worksheets.Cells(j, 1).Value = Workbooks(fn1).Worksheets("Sheet1").Cells(i, 1).Value Then //それぞれのブックのセルの値を比較していくここ、一行を分割する時に必要な_がないので構文エラーが発生しているのではないでしょうか

行動規範の内容に同意します

回答1件

ベストアンサー

Workbook.Worksheetsプロパティの使い方が全体的におかしいです。変数宣言の位置なども見直した方がいいでしょう。

VBA
1Option Explicit
2Sub sisaku1()
3'
4' sisaku1 Macro
5
6'
7'
8    Dim ws1 as worksheet 'thisworkbook内のシート操作用
9    
10    Dim wbF As Workbook
11    Dim wsF As Worksheet
12    Dim j As Integer  '比較する先のファイルの行
13    Dim i As Integer '貼り付け先のファイルの行   
14    
15    Dim fn As String
16    fn = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xlsx")
17    
18    
19    If fn = "False" Then
20        MsgBox "ファイルが選択されませんでした"
21        Exit Sub
22    End If
23    
24    With Application
25        .ScreenUpdating = False
26        .EnableEvents = False
27        
28    End With
29    Set wbF = Workbooks.Open(fn)
30    MsgBox fn '開いたファイル名を表示
31    Set wsF = wbF.Sheets("Sheet1")
32    
33    
34    For Each ws1 In ThisWorkbook.Worksheets  '貼り付け先のすべてのシートを参照
35        
36        
37        For i = 1 To 1000
38            For j = 1 To 1000
39                If ws1.Cells(j, 1).Value = wsF.Cells(i, 1).Value Then 'それぞれのブックのセルの値を比較していく
40
41                    ws1.Cells(j, 2).Value = wsF.Cells(i, 2).Value
42                    ws1.Cells(j, 3).Value = wsF.Cells(i, 3).Value
43                    Exit For '同じ項目はないだろうからさっさと飛ばす
44                    
45                End If
46            Next j
47        Next i
48    Next
49    
50    With Application
51        .ScreenUpdating = True
52        .EnableEvents = True
53    End With
54    
55End Sub
56