VBA オートフィルタ解除の方法

Question

Sub 担当別一覧()
    With Worksheets("ローデータ")
        .Range("D5").AutoFilter _
            Field:=4, Criteria1:="=ISAKA"
        .Range("E5").AutoFilter _
            Field:=5, Criteria1:="=フォロー中", Operator:=xlOr, Criteria2:="=挨拶待ち"
        .Range("G5").AutoFilter _
            Field:=7, Criteria1:=">=1"
        .Range("O5").AutoFilter _
            Field:=15, Criteria1:="="
            
        '1～4行目を非表示
        'Rows("1:4").Hidden = True

        'H～N列,P～T列を非表示
        Columns("H:J").Hidden = True
        Columns("L:T").Hidden = True
    
        Range("A1").CurrentRegion.Copy Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Offset
    End With
    'オートフィルタを解除する
    Worksheets("ローデータ").AutoFilterMode = False
End Sub

該当する担当者一覧をオートフィルタでまとめてsheet2へコピーした後ローデータの方は他の担当者分を
同じ作業しないといけないのでオートフィルタを解除しないといけないのですが上記のコードだと
列が表示されません。（あと、ちゃんと解除されているのか心配です）
列の再表示のコードもあるのでしょうか？

Answer 1

下記のように追加してみてはどうでしょうか？

'オートフィルタを解除する
Worksheets("ローデータ").AutoFilterMode = False

Worksheets("ローデータ").Columns("H:J").Hidden = False '追加
Worksheets("ローデータ").Columns("L:T").Hidden = False '追加

Comments

[cat_junko]

ありがとうございます。
上記、コードで出来ました。
もう一つ教えてください。
フィルターを５行目（A5～T5）セルにタイトルが入っているのでそこを基準に
設定したいのですがどうすればそこを基準にしてくれるのかがわかりません。
何度やってもタイトル行が消えてしまいます。
HとL、IとM、JとN行目を、上記と同じように作業します。

１行目～４行目までは、その他の情報が入っていて５行目にタイトル行があります。
担当者別で、合計４つの表が一つのシートに入り担当者が現在7名です。
担当者別なので、「担当者マスタ」を作成し回すのがいいのかなと考えています。
どのようなコードになるのか困っています。

[退会済みユーザー]

追加の質問ですが、質問にあるコードとは別物でしょうか？
下記のようにExcelで操作してみましたが、タイトルが消えることはありませんでした。
コードがないと助言は難しいです。
①A1～D4まで適当に値を入力
②A5～T5まで「タイトルn」を入力
③A6～T8まで適当に値を入力
④5行目にオートフィルタを設定
⑤フィルタを掛ける
→5行目は消えませんでした。

[cat_junko]

動くときと、動かない時の理由は良く分からないけど動いていました。
上記に、加えてのコードがほしいと思い追加質問しました。
<code>
Sub 担当別一覧()
Dim shrow
Dim list

'-----------------------------------------------
With Worksheets("ローデータ")
.Rows("5:5").Select
Selection.AutoFilter

.Range("D5").AutoFilter _
Field:=4, Criteria1:="=ISAKA"
.Range("E5").AutoFilter _
Field:=5, Criteria1:="=フォロー中", Operator:=xlOr, Criteria2:="=挨拶待ち"
.Range("G5").AutoFilter _
Field:=7, Criteria1:=">=1"
.Range("O5").AutoFilter _
Field:=15, Criteria1:="="

'1～4行目を非表示
Rows("1:4").Hidden = True

'H～N列,P～T列を非表示
Columns("H:J").Hidden = True
Columns("L:T").Hidden = True

Range("A5").CurrentRegion.Copy Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Offset
End With
'オートフィルタを解除する
'1～4行目を非表示
Rows("1:4").Hidden = False

'H～N列,P～T列を非表示
Columns("H:J").Hidden = False
Columns("L:T").Hidden = False

'手順②-------------------------------------------------
With Worksheets("ローデータ")
.Rows("5:5").Select
Selection.AutoFilter

.Range("D5").AutoFilter _
Field:=4, Criteria1:="=ISAKA"
.Range("E5").AutoFilter _
Field:=5, Criteria1:="=フォロー中", Operator:=xlOr, Criteria2:="=挨拶待ち"
.Range("H5").AutoFilter _
Field:=8, Criteria1:=">=1"
.Range("P5").AutoFilter _
Field:=16, Criteria1:="="

'1～4行目を非表示
Rows("1:4").Hidden = True

'H～N列,P～T列を非表示
Columns("G:G").Hidden = True
Columns("I:J").Hidden = True
Columns("K:K").Hidden = True
Columns("M:T").Hidden = True

shrow = Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp) + 2
.Range("A5").CurrentRegion.Copy Sheets("sheet1").shrow

'オートフィルタを解除する
Worksheets("ローデータ").AutoFilterMode = False

Worksheets("ローデータ").Columns("G:G").Hidden = False
Worksheets("ローデータ").Columns("I:J").Hidden = False
Worksheets("ローデータ").Columns("K:K").Hidden = False
Worksheets("ローデータ").Columns("M:T").Hidden = False
end with
end sub
</code>

[cat_junko]

上記は、①、②のみですが③と④があります。
①の条件で、抽出しシートに書き出したあと②を①の表の２行下くらいに貼り付けたい
のですがどうも動作してくれません。
ついでに、シートを追加してシート名を担当者名に変更しながら動作すると良いのですが。
宜しくお願いいたします。