サブフォルダ（データ）にある複数の.xlsxファイルのSheet3のA2セルの値で01から左側をB2

サブフォルダ（データ）にある複数の.xlsxファイルのSheet3のA2セルの値で01から左側をB2セルへコピーし、アンダーバーより左の値をB1セルへコピーし、右をC1セルへコピーしたい。下記コードを実行すると「Worksheets("Sheet3").Cells(2, 1).Select」でデバックになります。何処を修正したら良いか教えてください。よろしくお願いいたします。
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Sub コード商品切り出し()
Dim FolderName As String '文字列を入れる変数として「FolderName」を使う
Dim index As Integer '数字を入れる変数として「index」を使う
Dim FileName As String '文字列を入れる変数として「FileName」を使う
Dim N As Long
Dim O As Long
Dim P As Long
FolderName = Application.GetOpenFilename 'ダイアログを用いて選択したファイルのパスをFolderNameとする①
If FolderName = "False" Then 'FolderNameが選択されていなければ作業を終了する
Exit Sub
End If
'今のフォルダ名には選択したファイル名含まれているので、ファイル名の部分を切り取る作業。
index = InStrRev(FolderName, "\") 'フォルダ名部分の文字数をカウントする
FolderName = Left(FolderName, index) ' カウントした文字数までの部分を切り取ってフォルダ名とする
FileName = Dir(FolderName & "*xlsx") ' フォルダの中に含まれるファイルを取り出す
Do While FileName <> "" ' ファイルがなくなるまで繰り返す
Workbooks.Open FolderName & FileName 'ファイルを開く

Worksheets("Sheet3").Cells(2, 1).Select

N = InStr(ActiveCell, "01")
O = InStr(ActiveCell, "_")
P = InStr(ActiveCell, "_")
ActiveCell.Offset(0, 1) = Left(ActiveCell, N - 1)
ActiveCell.Offset(-1, -1) = Left(ActiveCell, O - 1)
ActiveCell.Offset(-1, 0) = Right(ActiveCell, P)

Workbooks(Workbooks.Count).Save
Workbooks(Workbooks.Count).Close
FileName = Dir() '
Loop
End Sub

質問者からの補足コメント

• 下記コードに書き換えたところ、別のデバッグとなりました。
  Sub コード商品切り出し2()
  Dim FolderName As String
  Dim index As Integer
  Dim FileName As String
  Dim wbk As Workbook
  Dim cel As Range
  Dim N As Long
  Dim O As Long
  Dim P As Long

    補足日時：2022/08/14 17:31

• FolderName = Application.GetOpenFilename
  If FolderName = "False
  Exit Sub
  End If
  index = InStrRev(FolderName, "\")
  FolderName = Left(FolderName, index)
  FileName = Dir(FolderName & "*xlsx")
  Do While FileName <> ""
  Set wbk = Workbooks.Open(FolderName & FileName) 'ファイルを開く
  Set cel = wbk.Worksheets("Sheet3").Cells(2, 1)

    補足日時：2022/08/14 17:33

• N = InStr(cel, "01")
  O = InStr(cel, "_")
  P = InStr(cel, "_")
  cel.Offset(0, 1) = Left(cel, N - 1)
  cel.Offset(-1, -1) = Left(cel, O - 1)
  cel.Offset(-1, 0) = Right(cel, P)
  wbk.Close True
  FileName = Dir() '
  Loop
  End Sub

    補足日時：2022/08/14 17:34

• デバック箇所「cel.Offset(-1, -1) = Left(cel, O - 1)」
  実行時エラー'1004'アプリケーション定義またはオブジェクト定義のエラーです。改善点をご教授頂けたませんでしょうか？よろしくお願いします。

    補足日時：2022/08/14 17:35

No.1 回答者： fujillin 回答日時： 2022/08/14 16:59

こんにちは

エラーの内容が示されていませんが「Selectメソッドが失敗しました」という内容のものでしょうか？

であるなら、対象シートがアクティブになっていないことが原因ではないかと想像されます。
ブックを開くと、前回保存時のシートがアクティブになると思いますけれど、それがSheet3ではない場合に、ご提示のメソッドはエラーになります。

現状のままで処理したければ、
＞Worksheets("Sheet3").Cells(2, 1).Select
の前に
　Worksheets("Sheet3").Activate
を入れておけば、エラーは出なくなるでしょう。
（Sheet3が存在していることが条件です。存在しなければエラーになります）


なお、ご質問には直接関係ありませんけれど・・
・複数のブックを扱う場合には、ブックを明示した記述にしておく方が、間違えは少なくなります。
・SelectやActiveCellを用いずに、Rangeを利用すれば、直接読み書きが可能ですので、シートをActiveにする必要はなくなります。
　With Worksheets("Sheet3").Cells(2, 1)
　　N = InStr(.Text, "01")
　　　　～～
　　.Offset(0, 1).Value = Left(.Text, N - 1)
　　　　～～
　End With
といった具合。
・ファイルダイアログを用いていますが、実際にはフォルダを指定するのが目的のようですので・・
　Dim FolderPath As String
　With Application.FileDialog(msoFileDialogFolderPicker)
　　If .Show = True Then FolderPath = .SelectedItems(1)
　End With
のような形にすれば、フォルダパスを取得できます。
（キャンセルの場合は空白文字列）

No.2 ベストアンサー 回答者： fujillin 回答日時： 2022/08/14 17:45

No1です

補足をみましたが・・・

＞Set cel = wbk.Worksheets("Sheet3").Cells(2, 1)
としているので、cel はA2セルを意味していることになります。
これに対して

＞cel.Offset(-1, -1) = ~~
は、一つ上で、一つ左側のセルと言う意味になりますが、存在しないセルを指定していませんか？

この回答へのお礼

確かに存在しないセルでした。ありがとうございます。別の問題に気がつきましたので考えて解決しないようなら改めて質問させてください。
ありがとうございました。

お礼日時：2022/08/14 20:13