マクロ オートフィルター後指定列のコピペ Excel

Question

###前提・実現したいこと
マクロで取込データを、別データのフォーマットの項目でフィルターをかけ、
指定列ごとコピーしフォーマット側にペースト、
次の項目でフィルターをかけ、指定列ごとコピーしフォーマット側にペーストを繰り返し、
フォーマット側の項目がなくなったら次シートの項目でフィルターをかけて……
というループをさせ、最終シートまで繰り返す。
というマクロを作っているのですが、
オートフィルターの部分でエラーが出ます。
調べてみても原因が特定できませんでした。

Option Explicit

Dim gyo As Long
Dim gyo2 As Long
Dim gyo3 As Long
Dim filecount As Long
Dim sheetcount As Long
Dim unmatch As Long
Dim erfilecount As Long
'ボタンを押したとき
Sub FolderSelect()
    'ThisWorkbook.Worksheets(1).Range("A6:C3005").ClearContents
    'ThisWorkbook.Worksheets(2).Range("B1:BE3005").ClearContents
    Dim folderpass As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            folderpass = .SelectedItems(1)
        Else
            ThisWorkbook.Worksheets(1).Range("B3").Value = "キャンセルしました。"
            Exit Sub
        End If
    End With
    
    filecount = 0
    sheetcount = 0
    unmatch = 0
    erfilecount = 0
    gyo = 6
    gyo2 = 2
   
    
    ThisWorkbook.Worksheets(1).Range("B2").Value = "処理中"
    
    Call FileSearch(folderpass, "*.csv")
   Dim dateupdate As String
   dateupdate = Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日更新"
   'ThisWorkbook.Worksheets(2).Range("A1").Value = dateupdate
   'ThisWorkbook.Worksheets(2).Name = dateupdate '
   ThisWorkbook.Worksheets(1).Range("B2").Value = "完了"
   ThisWorkbook.Worksheets(2).Activate
End Sub
'ファイル検索
Sub FileSearch(Path As String, Target As String)
    Dim FSO As Object, Folder As Variant, File As Variant
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each Folder In FSO.GetFolder(Path).SubFolders
        Call FileSearch(Folder.Path, Target)
    Next Folder
    For Each File In FSO.GetFolder(Path).Files
        If File.Name Like Target Then
            filecount = filecount + 1
            ThisWorkbook.Worksheets(1).Cells(gyo, 1) = File.Name
            ThisWorkbook.Worksheets(1).Cells(gyo, 2) = File.Path
            Call ParCopy(File.Path)
            gyo = gyo + 1
        End If
    ThisWorkbook.Worksheets(1).Range("B3").Value = filecount & "個のファイルが見つかりました。"
    Next File
End Sub
''一覧出力
Sub ParCopy(Path As String)


    Dim openbook As Workbook
    Dim openbooksheet As Worksheet
    Dim lp As Long
    Dim el As Long
    Dim br As String
    'オ
    Dim c As Range, Target As Range
    Dim LastRow As Long
    '縦軸(マクロ側シート数用)
    lp = 2
    '横軸(データ側ループ管理用)
    el = 3

    
    
    Application.ScreenUpdating = False

    On Error GoTo myError
    Set openbook = Application.Workbooks.Open(Path)



        Set openbooksheet = openbook.Worksheets(1)
        openbooksheet.Unprotect
        
        
      Do Until lp = 28
    
        Do Until Cells(el, 1) = ""
        
          br = ThisWorkbook.Worksheets(lp).Cells(2, el)
          
          openbooksheet.Activate
          
          Selection.AutoFilter
          openbooksheet.Range("A1").AutoFilter Field:=8, Criteria1:=br
          
          LastRow = Cells(Selection.Rows.Count, 1).End(xlUp).Row
          
          openbooksheet.Range("J2:J" & LastRow).Copy ThisWorkbook.Worksheets(lp).Range(ThisWorkbook.Worksheets(lp).Cells(3, el), ThisWorkbook.Worksheets(lp).Cells(3, el))
          openbooksheet.Range("A1").AutoFilter
    
      
          el = el + 1
    
        Loop
         
         lp = lp + 1
      Loop
       

  
    openbook.Close False
    

    Application.ScreenUpdating = True
    Exit Sub
myError:
    MsgBox Err.Description
    ThisWorkbook.Worksheets(1).Cells(gyo, 3) = "エラー発生"
    erfilecount = erfilecount + 1
    Application.ScreenUpdating = True
End Sub

###試したこと
Criteria1の部分をもともとはセルで指定していたのですが、
それがいけないのかと思い変数に格納してからフィルターをかけても、
なぜかオートフィルタメソッドが失敗しましたと表記されます。
まず、この方法で綿足の考えているような動作をさせることができるのか教えていただけると幸いです。
よろしくお願いします。
###補足情報
前回使用していたマクロを改変して作っているので謎の項目があるかもしれませんがご容赦ください。
追記１
あからさまにおかしい箇所が数点あったので修正しました。
追記２
ほぼ自己解決できました。

Option Explicit

Dim gyo As Long
Dim gyo2 As Long
Dim gyo3 As Long
Dim filecount As Long
Dim sheetcount As Long
Dim unmatch As Long
Dim erfilecount As Long
'ボタンを押したとき
Sub FolderSelect()
    'ThisWorkbook.Worksheets(1).Range("A6:C3005").ClearContents
    'ThisWorkbook.Worksheets(2).Range("B1:BE3005").ClearContents
    Dim folderpass As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            folderpass = .SelectedItems(1)
        Else
            ThisWorkbook.Worksheets(1).Range("B3").Value = "キャンセルしました。"
            Exit Sub
        End If
    End With
    
    filecount = 0
    sheetcount = 0
    unmatch = 0
    erfilecount = 0
    gyo = 6
    gyo2 = 2
   
    
    ThisWorkbook.Worksheets(1).Range("B2").Value = "処理中"
    
    Call FileSearch(folderpass, "*.csv")
   Dim dateupdate As String
   dateupdate = Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日更新"
   'ThisWorkbook.Worksheets(2).Range("A1").Value = dateupdate
   'ThisWorkbook.Worksheets(2).Name = dateupdate '
   ThisWorkbook.Worksheets(1).Range("B2").Value = "完了"
   ThisWorkbook.Worksheets(2).Activate
End Sub
'ファイル検索
Sub FileSearch(Path As String, Target As String)
    Dim FSO As Object, Folder As Variant, File As Variant
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each Folder In FSO.GetFolder(Path).SubFolders
        Call FileSearch(Folder.Path, Target)
    Next Folder
    For Each File In FSO.GetFolder(Path).Files
        If File.Name Like Target Then
            filecount = filecount + 1
            ThisWorkbook.Worksheets(1).Cells(gyo, 1) = File.Name
            ThisWorkbook.Worksheets(1).Cells(gyo, 2) = File.Path
            Call ParCopy(File.Path)
            gyo = gyo + 1
        End If
    ThisWorkbook.Worksheets(1).Range("B3").Value = filecount & "個のファイルが見つかりました。"
    Next File
End Sub
''一覧出力
Sub ParCopy(Path As String)


    Dim openbook As Workbook
    Dim openbooksheet As Worksheet
    Dim lp As Long
    Dim el As Long
    Dim br As String
    'オ
    Dim c As Range, Target As Range
    Dim LastRow As Long
    '縦軸(マクロ側シート数用)
    lp = 2
    '横軸(データ側ループ管理用)
    el = 3

    
    
    Application.ScreenUpdating = False

    On Error GoTo myError
    Set openbook = Application.Workbooks.Open(Path)



        Set openbooksheet = openbook.Worksheets(1)
        openbooksheet.Unprotect
        
        
      Do Until lp = 28
    
        Do Until ThisWorkbook.Worksheets(lp).Cells(2, el) = ""
        
          br = ThisWorkbook.Worksheets(lp).Cells(2, el)
          
          openbooksheet.Activate
          
          Selection.AutoFilter
          openbooksheet.Range("A1").AutoFilter Field:=8, Criteria1:=br
          
          LastRow = 291826
          
          openbooksheet.Range("J2:J" & LastRow).Copy ThisWorkbook.Worksheets(lp).Range(ThisWorkbook.Worksheets(lp).Cells(3, el), ThisWorkbook.Worksheets(lp).Cells(3, el))
          openbooksheet.Range("A1").AutoFilter
    
      
          el = el + 1
    
        Loop
         
         el = 3
         
         lp = lp + 1
      Loop
       

  
    openbook.Close False
    

    Application.ScreenUpdating = True
    Exit Sub
myError:
    MsgBox Err.Description
    ThisWorkbook.Worksheets(1).Cells(gyo, 3) = "エラー発生"
    erfilecount = erfilecount + 1
    Application.ScreenUpdating = True
End Sub

データ側のシートをフォーマット側（マクロ）の各項目でフィルタをかけて
コピー、ペーストするというマクロです。
同じようなマクロを作る際の参考程度にしてください。
ただし、不要な部分も多いので要改変です。

Answer 1

AutoFillterのエラーについて

こちらの環境(Win7/Office2010)で実行してみたところ、AutoFillterはアクティブシートでなくても問題なく動作しました。
（ちなみにCriteria1を直接セルで指定しても、そのセルの値で正しく絞り込んでくれました。）

ただ、AutoFillterで作成されたフィルター列が8列もないのに8列目を指定して絞り込もうとした際に、AutoFillterのエラーが発生しました。
たまたまデバッグしながら動作させていて、関係ないエクセルファイルをアクティブにしてしまった時に発生したのですが、似たような状況、もしくはそのようなフィルターになるファイルを対象に指定していないでしょうか？

その他のアドバイス

以下はコードの書き方に対するアドバイスです。

アクティブシートに対する操作は対象シートを明記しなくても操作が可能です。
例：アクティブシート(Sheet1)のC2セルを取得する場合、以下のように参照できる。

sValue = Cells(2, 3)

ですが、複数のシートを扱うコードを書く場合、面倒でもどのシートに対する操作になるのかを明示したほうが、結果的に見やすくなり、処理も追いやすくなります。
また処理途中でのユーザー操作によって意図しない動作になる事故も防げます。

例：アクティブシート(Sheet1)のC2セルを取得する場合でも、以下のように対象シートを明示して参照する。

sValue = Sheet1.Cells(2, 3)

---

同じくコードを見やすくするテクニックとして、面倒でも処理内容をコメントとして記述する、というものがあります。
書き込みすぎる必要はありませんが、「この処理はこんな目的で記述している」ということがわかることで、プログラムを追う際に整理しながら調査を進めることができます。
これにより、
・この処理はコピー元セルのA1セルの値を取得するものなので、A1には"AAA"が入力されているから、取得値は"AAA"になるはず。
といったことがわかりやすくなり、デバッグ中に意図しない("AAA"ではない)値となった時に、「何かがおかしい」と気が付けるようになります。

コードがうまく動かないときにこそ、面倒くさがらずにコメントを書いてみてください。

Comments

[teryyyyy2]

JAWAさん、前回に引き続き本当にありがとうございます。
今回はあまりはまることなくほぼ自己解決することが出来ました。
今回かなりスムーズに進めることができたのは、
前回ご教授いただいたことが大きいと感じています。

AutoFillterについて
その部分に関しましては、指定データをActivateしたことによって解決しました。
環境の違いなのでしょうか…（win10/office2013）動いているので問題はないでしょうがまたこのような事態にならないためにも検証は行ってみます。

アドバイスについて
このようなことまでアドバイスしていただき本当に感謝しています。
確かにソースを書いていてわけがわからなくなることは多々ありますので
コメントアウトする事は念頭に置いてこれから進めていこうと思います。

今後も自己解決できなくなったときには頼らせていただければなと思います。
本当にありがとうございます。

[jawa]

解決したようで何よりです。

エラーの発生についてもう少しわかったことがありましたので補足させて下さい。

おそらく今回のエラー発生個所は
```
Selection.AutoFilter
```
だったのではないかと思います。

シートを指定せず、選択位置に対してAutoFilterをかける記述になっています。

このため、意図せず他のシートがアクティブな状態でこのマクロが動作すると、その時アクティブなシートの選択されている位置に対してAutoFilterをかけることになってしまいます。

例えば空のシートでAutoFilterをかけようとしてもエラーが発生してしまいますが、これと同様に選択されているセルがオートフィルターをかけられないような位置だった場合にエラーが発生していたのではないかと思われます。

今回マクロではcsvファイルをオープンした直後で、セル位置も設定する前の処理ですので、通常であれば開いたCSVファイルのA1セルが選択されており、それに対してAutoFilterをかける処理を期待していたと思います。
そうであれば、
```
Selection.AutoFilter
```
ではなく
```
openbooksheet.Range("A1").AutoFilter
```
としたほうがよかったのかもしれません。

ちなみにその直後にしっかりシートとセル位置を指定したAutoFilterの記述
```
openbooksheet.Range("A1").AutoFilter Field:=8, Criteria1:=br
```
があります。

こちらは「絞り込む操作」として記述されたのかもしれませんが、こちらだけでもAutoFilterをかけたうえで絞り込みまでしてくれます。

事前に
```
Selection.AutoFilter
```
をする必要はないと思います。

長くなってしまいましたが、要点としては
・対象シートを明示したほうが事故が起きにくい
・openbooksheet.Range("A1").AutoFilter Field:=8, Criteria1:=br だけでも絞り込みできる
です。

[teryyyyy2]

なるほど…一応今回のマクロは一度クロージングしてしまったのですが、
今から機能追加をしますので、一緒に修正をかけてみます。
その機能追加に関しましても、調べてはみたのですが考えが至らず…
お力をお借り出来たら嬉しく思います。
よろしくお願いします。

Answer 2

たしかオートフィルタはアクティブなシートにしか設定できなかったような気がします。
なのでエラーになっているのでは。
間違ってたらすいません…。

Comments

[teryyyyy2]

Activateしたらフィルタのエラーがなくなりました！
ありがとうございます！

[tomo.ina]

よかったです。
私も前にアクティブになっていなくてはまった記憶があるので。
Excel VBAはアクティブなシートにしかできない命令もあるので、
疑ってみるのもよいかと思います。
ただ、やたら何でもアクティブにするのは処理速度やプログラムのきれいさに
かけるのでお勧めはしませんが…。

[teryyyyy2]

いいアドバイスありがとうございます。
そうですね…処理データが30万件あるものを今回は作っていまして処理速度等は常に考えてはいました。
これから勉強して対応できるようにしてみます。
ありがとうございました。