実行時エラー“424”

Question

実現したいこと

商品別売上日報集計に、日付を入れて実行すると下記の動きをさせる。

該当する日付の、商品別売上日報のシート(出荷)を開く。

商品毎に数値をコピーし、日報集計ブックに商品毎に用意されたシートで日付を検索してコピーした、数値を貼り付ける。

発生している問題・分からないこと

デバッグで、実行時エラー424が発生。

下記の位置で止まります。
Set wsBalance = Worksheet("出荷").Select

エラーメッセージ

実行時エラー‘424’
オブジェクトが必要です。

該当のソースコード

Sub CopyDataBasedOnDate()
    Dim wbSummary As Workbook
    Dim wsTranscribe As Worksheet
    Dim wsBalance As Worksheet
    Dim folderPath As String
    Dim fileName As String
    Dim dateToFind As String
    Dim foundDate As Range
    
    ' 日報集計ブックを設定する
    Set wbSummary = ThisWorkbook
    Set wsTranscribe = wbSummary.Sheets("転記")
    
    ' 日付を取得する
    dateToFind = wsTranscribe.Range("C4").Value
    
    ' 指定されたフォルダを検索する
    folderPath = "指定されたフォルダのパス"
    fileName = Dir(folderPath & "\残高日報*" & Format(dateToFind, "mmdd") & ".xlsm")
    
    ' ブックが見つかった場合
    If fileName <> "" Then
        ' ブックを開く
        Workbooks.Open (folderPath & "\" & fileName)
        Set wsBalance = Worksheet("出荷").Select
        
        ' 商品データをコピーして貼り付ける
        CopyAndPasteData wsBalance.Range("F8:F28"), wbSummary.Sheets("商品A")
        CopyAndPasteData wsBalance.Range("G8:G28"), wbSummary.Sheets("商品B")
        ' 各シートに対するコピーと貼り付けを続ける
        
        ' ブックを閉じる
        ActiveWorkbook.Close
    Else
        MsgBox "指定された日付の商品別売上日報が見つかりませんでした。"
    End If
End Sub

Sub CopyAndPasteData(rngSource As Range, wsTarget As Worksheet)
    Dim cell As Range
    Dim rngTarget As Range
    
    ' 貼り付け先のセルを探す
    Set rngTarget = wsTarget.Range("F2:Z2,F26:Z26,F50:Z50,F74:Z74,F98:Z98,F122:Z122").Find(What:=rngSource.Cells(1, 1).Value, LookIn:=xlValues, LookAt:=xlWhole)
    
    ' 貼り付け先が見つかった場合
    If Not rngTarget Is Nothing Then
        ' 貼り付ける
        rngSource.Copy
        wsTarget.Cells(rngTarget.Row + rngSource.Row - rngSource.Cells(1, 1).Row, rngTarget.Column).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End If
End Sub

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

「値がからの場合やSETが使われていない場合に発生」とありましたが、
値は確かに入っていますし、型としてVARIANTやRANGEを使用しているわけではありません。

補足

特になし

Comments

[tatsu99]

詳しくは見ていませんが
Set wsBalance = Worksheet("出荷").Select　を
Set wsBalance = Worksheet("出荷")
にしてはいかがでしょうか。

[ATSUHAYAshi]

修正しました。

商品別売上日報はシート6枚で構成されており、シート4枚が選択された状態で保存されてます。(うち２枚は非表示)

日報が開くには開くのですが、複数選択された状態で開く。

エラーは無し。

コピー、貼り付けが機能してないのか？

という状況です。

[tatsu99]

>日報が開くには開くのですが、複数選択された状態で開く。
>エラーは無し。
>コピー、貼り付けが機能してないのか？

CopyAndPasteDataの中で、貼り付け先が見つかっていないのではないでしょうか。
４９行目　rngSource.Copy
にブレイクポイントを設定し、そこで止まれば、見つかっています。
止まらなければ、見つかっていません。まず、そこで、切り分けてください。

[ATSUHAYAshi]

止まりませんでした。

[deka]

Set wb = Workbooks.Open (folderPath & "\" & fileName)
Set wsBalance = wb.Worksheets("出荷")

ではだめですかね？

[ATSUHAYAshi]

変わらずでした。

Answer 1

Sub CopyDataToSummary()
の修正項目です。
①dateToFind の型をDate型に変更
②CopyAndPasteData の呼び出し時の引数にdateToFind を追加

①
Dim dateToFind As Date
②
CopyAndPasteData wsBalance.Range("F8:F28"), wbSummary.Sheets("商品A"), dateToFind
他の商品も同様

CopyAndPasteDataの変更

Sub CopyAndPasteData(rngSource As Range, wsTarget As Worksheet, dateToFind As Date)
    Dim cell As Range
    Dim rngTarget As Range
    Dim wrng As Range
    Set rngTarget = Nothing
    For Each wrng In wsTarget.Range("F1:Z1,F25:Z25,F49:Z49,F73:Z73,F97:Z97,F121:Z121")
        If wrng.Value = dateToFind Then
            Set rngTarget = wrng
            Exit For
        End If
    Next

    If Not rngTarget Is Nothing Then
        '貼り付ける
        rngSource.Copy
        wsTarget.Cells(rngTarget.Row + rngSource.Row - rngSource.Cells(0, 1).Row, rngTarget.Column).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False

    End If

End Sub

Comments

[ATSUHAYAshi]

ありがとうございます。

理想通りの動きをしました。

ただ貼り付け元のブックが、シート4枚を選択した状態で保存されているのでエラーでてしまう。
複数選択を解除して保存し直したブックなら、エラーが出ないので、その辺は担当者にお願いしてみようと思います。

[tatsu99]

>ただ貼り付け元のブックが、シート4枚を選択した状態で保存されているのでエラーでてしまう。
その場合、どの行でエラーになりますか。
Set wsBalance = wb.Worksheets("出荷")
のつぎに
wsBalance.Select
を入れれば、複数選択されたシートの解除ができます。

Answer 2

findメソッドで日付を検索する場合は、いろいろと問題があるようです。
こちらで簡単な環境をつくり、試してみましたが、findで期待した結果になりません。
以下は、findの使用をやめて、１セル毎に、比較を行う方法です。
CopyAndPasteDataを以下のように変えてください。
気になるのは、処理時間ですが、体感的に問題なければ、それでよいかと思います。
遅くて、ダメだという場合は再考しないといけませんが・・・・。

Sub CopyAndPasteData(rngSource As Range, wsTarget As Worksheet)
    Dim cell As Range
    Dim rngTarget As Range
    Dim wrng As Range
    Set rngTarget = Nothing
    ' 貼り付け先のセルを探す
    For Each wrng In wsTarget.Range("F2:Z2,F26:Z26,F50:Z50,F74:Z74,F98:Z98,F122:Z122")
        If wrng.Value = rngSource.Cells(1, 1).Value Then
            Set rngTarget = wrng
            Exit For
        End If
    Next
   ' 貼り付け先が見つかった場合
    If Not rngTarget Is Nothing Then
        ' 貼り付ける
        rngSource.Copy
        wsTarget.Cells(rngTarget.Row + rngSource.Row - rngSource.Cells(1, 1).Row, rngTarget.Column).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End If
End Sub

Comments

[ATSUHAYAshi]

Sub CopyDataToSummary()
　Dim wbSummary As Workbook
Dim wsTranscribe As Worksheet
Dim wsBalance As Worksheet
Dim folderPath As String
Dim fileName As String
Dim dateToFind As String
Dim foundDate As Range

' 日報集計ブックを設定
Set wbSummary = ThisWorkbook
Set wsTranscribe = wbSummary.Sheets("転記")

'日付を取得
dateToFind = wsTranscribe.Range("C3").Value
Debug.Print dateToFind

' 指定されたフォルダ内のファイルを検索
folderPath = ' フォルダのパスを指定
fileName = Dir(folderPath & "\売上日報" & Format(dateToFind, "eemmdd") & ".xlsx")
Debug.Print folderPath
Debug.Print fileName

' ファイルが見つかった場合
If fileName <> "" Then
'ブックを開く
Set wb = Workbooks.Open(folderPath & "\" & fileName)
Set wsBalance = wb.Worksheets("出荷")

' 出荷をコピーして貼付け
CopyAndPasteData wsBalance.Range("F8:F28"), wbSummary.Sheets("商品A")
CopyAndPasteData wsBalance.Range("G8:G28"), wbSummary.Sheets("商品B")
CopyAndPasteData wsBalance.Range("J8:J28"), wbSummary.Sheets(“商品C”)
CopyAndPasteData wsBalance.Range("K8:K28"), wbSummary.Sheets("商品D")
CopyAndPasteData wsBalance.Range("L8:L28"), wbSummary.Sheets("商品E)
CopyAndPasteData wsBalance.Range("N8:N28"), wbSummary.Sheets("商品F")
CopyAndPasteData wsBalance.Range("O8:O28"), wbSummary.Sheets("商品G")
CopyAndPasteData wsBalance.Range("P8:P28"), wbSummary.Sheets("商品H")
CopyAndPasteData wsBalance.Range("Q8:Q28"), wbSummary.Sheets("商品I”)
CopyAndPasteData wsBalance.Range("R8:R28"), wbSummary.Sheets("商品J")
CopyAndPasteData wsBalance.Range("T8:T28"), wbSummary.Sheets("商品K")
CopyAndPasteData wsBalance.Range("W8:W28"), wbSummary.Sheets("商品L")
CopyAndPasteData wsBalance.Range("X8:X28"), wbSummary.Sheets("商品M")
CopyAndPasteData wsBalance.Range("Y8:Y28"), wbSummary.Sheets("商品N")
'
'ブックを閉じる
'ActiveWorkbook.Close
Else
MsgBox "指定された日付の売上日報が見つかりませんでした。"
End If
End Sub

Sub CopyAndPasteData(rngSource As Range, wsTarget As Worksheet)
Dim cell As Range
Dim rngTarget As Range

Set rngTarget = Nothing
For Each wrng In wsTarget.Range("F1:Z1,F25:Z25,F49:Z49,F73:Z73,F97:Z97,F121:Z121")
If wrng.Value = rngSource.Cells(3, 3).Value Then
Set rngTarget = wrng
Exit For
End If
Next

If Not rngTarget Is Nothing Then
'貼り付ける
rngSource.Copy
wsTarget.Cells(rngTarget.Row + rngSource.Row - rngSource.Cells(0, 1).Row, rngTarget.Column).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

End If

End Sub

このように直しました。
実行するとエラーは出ませんが、意図しない位置に張り付けされてしまう現象が出ています。

3/18という日付が、各貼り付け先シートのQ25にあれば、Q26からQ46に張り付けたいのですが、Y2が基準だったり、F95が基準だったりという状況です。

[tatsu99]

>3/18という日付が、各貼り付け先シートのQ25にあれば、Q26からQ46に張り付けたいのですが、Y2が基準だったり、F95が基準だったりという状況です。

意味がよくわかりません。
「Y2が基準だったり、F95が基準だったり」とは、どういうことでしょうか。
又、期待した結果になる場合とならない場合があるということでしょうか。
それとも、全て期待した結果にならないということでしょうか。

仕様の確認ですが
商品Aのシートでの検索で限定すると、
出荷シートのF8:F28が転記元になり、当該シートのH10に3/18の日付がある。
商品AのQ25に3/18の日付がある場合、商品AのQ26～Q46に出荷シートのF8:F28を貼り付けたい。
というのが仕様でしょうか。

[ATSUHAYAshi]

解りつらい文章で申し訳ないです。
本来であれば、Q26からQ46に貼りたいのですが、Y2からY22に貼られたり、F95からF115に貼られてしまうという事です。

[tatsu99]

Y2からY22に張られる場合は、F1～Z1にも該当日付がある場合のケースです。そこに3/18の日付がないか確認してください。

F95からF115に貼られるのは、考えにくいです。
F98～F118の間違いではないでしょうか。
そうであれば、3/18の日付が、F97～Z97にもある場合です。そこに3/18の日付がないでしょうか。

[ATSUHAYAshi]

仕様ですが、
商品Aで説明すると、
ブック(売上日報)のシート(出荷)のF8:F28が転記元です。

日付はブック(日報集計)のシート(転記)のc3にあります。

シート(商品A)のQ25が3/18であれば日付が、商品AのQ26～Q46に出荷シートのF8:F28を貼り付けいです。

[tatsu99]

>日付はブック(日報集計)のシート(転記)のc3にあります。
いきなり、新しいブックとシートが出てきましたが、この日付を参照している個所が、どこにもありません。
そのため、現行では、期待した結果になりません。このシートのC3を参照する箇所を追加しないとだめです。
又、商品Bの場合は、日付は、どのブックのどのシートのどのセルにあるのでしょうか。

[ATSUHAYAshi]

仕様の詳細ですが、
ブック(日報集計)シート(転記)(商品A)～商品(N)の１4枚で構成。
ブック(売上日報)シート(出荷)を含む6枚で構成。

転記C3に、日付を入力しVBAを実行すると、該当する売上日報を開く。

転記C3の日付と一致する日付を各商品のシートで検索して、(出荷)シートでコピーした数値を貼り付ける。
という動きをするようです。

(出荷)の、O4とX1にも日付が入ってますが、この日付は見ていません。

[tatsu99]

転記C3の日付をパラメータ渡すようにすれば良いかと思います。
別途、回答欄に書きます。