ExcelVBA シート関連

自分用のメモなので、形は整ってないです。

シートを削除する

'ワークシートの削除
Worksheets("シート7").Delete  'シート名指定で削除
Worksheets(3).Delete          '何番目のシートかで指定して削除。あまり使わないほうがいい
シート2.Delete                'オブジェクト名指定で削除

' グラフシートを削除する
Charts("グラフ1").Delete  'シート名指定で削除
Charts(1).Delete          '何番目のシートかで指定して削除。あまり使わないほうがいい
グラフ3.Delete            'オブジェクト名指定で削除

シートを追加する

Worksheets.Add   'ワークシートの追加

Charts.Add       ' グラフシートの追加

' 3番目のシートの後に追加
Worksheets.Add After:=Worksheets(3)

' 5番目のシートの前に追加
Worksheets.Add Before:=Worksheets(5)

' 末尾に追加
Worksheets.Add After:=Worksheets(Worksheets.Count)

' シートを2つ追加する
Worksheets.Add After:=Worksheets(Worksheets.Count), Count:=2


' シートを追加して、シート名も変更する方法の一例
With Worksheets.Add()  ' Addの後ろに()をつけると戻り値を返すので、Withが使える
  .Name = "追加シート"
End With

シートを移動する

Worksheets("abc").Move After:=Worksheets(Worksheets.Count)

' 別のブックへ移動する
Worksheets("abc").Move Before:=Workbooks("bbb.xlsx").Worksheets(Worksheets.Count)


' 移動先を指定しない場合、新規ブックとして作成される
Worksheets(3).Move

シートをコピーする　　非表示のシートについては注意

Sub aaa()

  Worksheets("abc").Copy after:=Worksheets(Worksheets.Count)
  
  ' 別のブックへコピーする
  Workbooks("bbb.xlsx").Activate
  Workbooks("aaa.xlsx").Worksheets("abc").Copy after:=Workbooks("bbb.xlsx").Worksheets(Worksheets.Count)
  
  ' コピー先を指定しない場合、新規ブックとして作成される
  Worksheets(3).Copy

End Sub


Sub bbb()

  Dim wsX As Worksheet
  
  Worksheets("シート1").Copy after:=Worksheets(Worksheets.Count)
  '「シート1」をコピーし、末尾に移動する
  Set wsX = Worksheets(Worksheets.Count)
  'コピー直後に末尾のシートをSetすれば、ほぼ間違いなくコピーしたシートが対象になるはず
  wsX.Name = "コピーしたシート"
  
  '※ Set wsX = ActiveSheet というコードは、間違いが起きやすいので使わないように
  
  
  '*****　非表示のシートについて  **************
  
  'Worksheets("隠しシート").Copy   非表示のシートの場合、このコードはエラーになる
  
  Worksheets("隠しシート").Visible = xlSheetVeryHidden  'VBAでしか再表示できないように非表示にする
  'Worksheets("隠しシート").Visible = xlSheetHidden      ' これは普通に非表示
  
  If Worksheets("隠しシート").Visible = xlSheetHidden Or _
    Worksheets("隠しシート").Visible = xlSheetVeryHidden Then
    '非表示シート、またはVBAでしか再表示できないように非表示になっている場合
    Worksheets("隠しシート").Visible = xlSheetVisible
  End If
  
  Worksheets("隠しシート").Copy after:=Worksheets(Worksheets.Count)
  Set wsX = Worksheets(Worksheets.Count)
  wsX.Name = "コピーした隠しシート"
  'ここまでやれば安全だろうか

End Sub

シートの表示・非表示

MsgBox Worksheets("aaa").Visible
  '表示の場合は-1　表示の場合は0
  
If Worksheets("aaa").Visible = xlSheetVisible Then
MsgBox "表示"
ElseIf Worksheets("aaa").Visible = xlSheetHidden Then
MsgBox "非表示"
End If
' TrueとFalseでもいいが、xlSheetVisible,xlSheetHiddenが本来か

Worksheets("aaa").Visible = xlSheetVisible  '表示する
Worksheets("aaa").Visible = xlSheetHidden   '非表示にする
Worksheets("aaa").Visible = True  '表示する
Worksheets("aaa").Visible = False   '非表示にする

Worksheets("aaa").Visible = Not Worksheets("aaa").Visible
'表示と非表示を交互に切り替え

オートフィルタで絞り込んだ結果から、特定列の合計･データ数を取得する

Range("B2").AutoFilter Field:=2, Criteria1:="冷蔵庫"  ' 2列を"冷蔵庫"で絞込み

Dim result As Long
Dim rowCount As Long

rowCount = Range("B2").CurrentRegion.Rows.Count - 1
'これは絞込みされている行数ではなく、表全体の行数になる

result = WorksheetFunction.Subtotal(9, Range(Cells(3, 6), Cells(rowCount, 6)))
MsgBox "「冷蔵庫」の売上の合計は: " & result
' 2列の「売上」の合計を求める。9で合計

result = WorksheetFunction.Subtotal(3, Columns(3)) - 1
MsgBox "「冷蔵庫」のデータ数は: " & result
' 「リンゴ」のデータ数を求める。3でデータ数
' 下の行にデータが無いなら、合計範囲の指定は列全体でもいいが、タイトル行の数も入ってしまうので-1しておく

オートフィルタで絞り込んだ行のみに対して、背景色変更、行削除などを実行

Cells(2, 2).AutoFilter 2, "ぶどう"  'フィルタをかける

With Cells(2, 2).CurrentRegion.Offset(1, 0)
  .Resize(.Rows.Count - 1).Interior.Color = RGB(0, 255, 0)
  'フィルタで絞り込まれた行のみを緑背景に
End With

ActiveSheet.ShowAllData  'フィルタ解除

Cells(2, 2).AutoFilter 2, "桃"

With Cells(2, 2).CurrentRegion.Offset(1, 0)
  .Resize(.Rows.Count - 1).EntireRow.Delete
  'フィルタで絞り込まれた行のみを削除
End With

オートフィルタの絞りこみの状態、絞込みの条件等を調べる

Cells(2, 2).AutoFilter 2, "桃"

If ActiveSheet.AutoFilterMode = True Then  'オートフィルタが設定されているか
  Debug.Print "設定されています"
Else
  Debug.Print "設定されていません"
End If

If ActiveSheet.FilterMode = True Then  'オートフィルタで絞り込まれているか
  Debug.Print "絞込みされている"
Else
  Debug.Print "絞込み無し"
End If

ActiveSheet.ShowAllData  'フィルタ解除

If ActiveSheet.FilterMode = True Then  'オートフィルタで絞り込まれているか
  Debug.Print "絞込みされている"
Else
  Debug.Print "絞込み無し"
End If

Cells(2, 2).AutoFilter 2, "スイカ"
Cells(2, 2).AutoFilter 3, ">2022/1/15"  '2つの条件で絞り込む

Dim i As Long

With ActiveSheet
  For i = 1 To .AutoFilter.Filters.Count
    Debug.Print i & "列目のタイトルは： " & .AutoFilter.Range(i)  '表のタイトル部分のセル値を取得できる

    If .AutoFilter.Filters(i).On = True Then  'その列で絞込みされている場合
      Debug.Print i & "列目のフィルタリング有り"
    Else
      Debug.Print i & "列目のフィルタリング無し"
    End If
  Next i
End With

ActiveSheet.ShowAllData  'フィルタ解除

Cells(2, 2).AutoFilter 4, "=23000", xlOr, "<10000"

Debug.Print ActiveSheet.AutoFilter.Filters(4).Criteria1
'4列目の、1番目の絞り込み条件を取得　結果は =23000

Debug.Print ActiveSheet.AutoFilter.Filters(4).Criteria2
'4列目の、2番目の絞り込み条件を取得　結果は <10000

'Debug.Print ActiveSheet.AutoFilter.Filters(4).Criteria3
'3番目の条件は無いので、これはエラーになる

全てのシートの名前を取得する(グラフシート含む)

Dim ws As Worksheet
Dim var1 As Variant
Dim cs As Chart

For Each ws In Worksheets   ' 全ワークシートの名前を取得。グラフシートは含まない
  Debug.Print ws.Name
Next ws

For Each var1 In Sheets   ' 全シートの名前を取得。グラフシートも含む
  Debug.Print var1.Name
Next var1

For Each cs In Charts      ' グラフシートのみを対称にするなら、これくらいかな
  Debug.Print cs.Name
Next cs

複数のシートを選択する

Sheets(Array("111", "222", "333")).Select
'シート名での指定だが、「WorkSheets(シート名)」の形ではないらしい

'※リンク先の情報では、シート名ではなくシートのコード名(Sheet1 など)で指定するとなっているが、
'Sheets(Array("Sheet1")).Select としてもエラーになってしまう。バージョンによる?　とりあえず2016では上のコードで

Sheets(Array(シート1.Name, シート2.Name, シート3.Name)).Select
'シート1、シート2、シート3はシートのオブジェクト名。
'シート名では変更される可能性があるので、これが一番確実かも

選択している全シート名を取得する

Sheets(Array("ブック", "設定", "その他")).Select
' "ブック", "設定", "その他" シートを選択

Dim ws As Worksheet
For Each ws In ActiveWindow.SelectedSheets  ' 選択しているシートを取得
  Debug.Print ws.Name
Next ws

シート名についての注意

Worksheets.Add(After:=Worksheets(Sheets.Count)).Name = "sheetX"   ' シート「sheetX」を追加

Worksheets.Add(After:=Worksheets(Sheets.Count)).Name = "SHEETX"
' シート「SHEETX」を追加。しかし「この名前はすでに使われています」というエラーメッセージが出て追加できない
' これはシート名は、大文字と小文字を区別しないため。"sheetX"と"SHEETX"は同じものと解釈されてしまうので注意

データのソート

' A～D列にデータがあり、1行目はタイトル行とする場合


' ※Excel2007以降で使えるやり方。パラメータの種類･設定値・既定値はリンク先参照

ActiveSheet.Sort.SortFields.Clear
' 現在のソート条件をクリア。これをしないと、現在の条件に新しい条件を追加する形になる
' これを実行すると、手作業でソートをした場合の条件もクリアされた状態になる

ActiveSheet.Sort.SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending
' ソート条件設定。D列でソート、セルの値でソート、昇順でソート　の条件


' 以下、ソート実行のためのコード
With ActiveSheet.Sort
  .SetRange Range("A1:D13")       ' データのある範囲
  .Header = xlYes                 ' 1行目をタイトル行とするか。今回はタイトル行と解釈する
  .MatchCase = False              ' 大文字と小文字を区別するか。文字列でソートならTrueにすべき
  .Orientation = xlTopToBottom    ' 並べ替えの方向。xlTopToBottom で普通に上下方向に並べ替え
  .SortMethod = xlPinYin          ' 日本語をふりがなで並べ替え。xlStroke にすると、文字コードで並べ替え
  .Apply    ' ソートを実行
End With


' 普通に、値・昇順ソートをするなら以下のように
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("A1")

With ActiveSheet.Sort
  .SetRange Range("A1:D13")   ' タイトル行も含めた、データの範囲を指定
  .Apply
End With


'複数の条件を指定する
With ActiveSheet.Sort
  .SortFields.Clear
  .SetRange Range("A1:D21")
  .SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending
  .SortFields.Add Key:=Range("C1"), SortOn:=xlSortOnValues, Order:=xlDescending
  '2番目の条件を指定。C列で降順
  .MatchCase = True
  .Apply
End With


' ※Excel2003までの方法
' ソート条件のクリアというものはないらしい。設定しない条件は、以前の条件が引き継がれるので、なるべく設定すべき

Range("A1:D13").Sort _
  Key1:=Range("B1"), Key2:=Range("D1"), Header:=xlYes, _
  Order1:=xlDescending, Order2:=xlAscending, MatchCase:=True
    
' データ範囲"A1:D13"、第1キーB列、第2キーD列、1行目をタイトルと解釈
'第1キーは降順、第2キーは昇順、大文字小文字は区別　でソート

シートの保護

With ActiveSheet
  .Protect      ' シートに保護設定
  .Unprotect    ' シート保護解除

  .Protect Password:="pass01"     ' シートにパスワード付きで保護設定
  .Unprotect Password:="pass01"     ' パスワード付きで保護設定されているシートの保護解除

  .Protect
  ' .Cells(1, 1).Value = "ABC"   ' 保護しているシートなので、セルの値は変えられない。このコードはエラーになる
  .Unprotect
  
  .Protect UserInterfaceOnly:=True  ' マクロでの操作を可能にして、保護をかける
  .Cells(1, 1).Value = "ABC"        ' これでセルの値を変更できる
End With


Workbooks.Open Filename:="aaa.xlsx"
ActiveWorkbook.Worksheets(1).Protect UserInterfaceOnly:=True  ' マクロでの操作を可能にして、保護をかける
ActiveWorkbook.Worksheets(1).Cells(1, 1).Value = "ABC"       ' これはエラーにならないのだが

ActiveWorkbook.Save
ActiveWorkbook.Close    ' 一度閉じて

Workbooks.Open Filename:="aaa.xlsx"
' ActiveWorkbook.Worksheets(1).Cells(1, 1).Value = "ABC"
' もう一度同ブックを開くと、マクロからの操作を受け付けなくなっている(エラーになる)

ActiveWorkbook.Worksheets(1).Protect UserInterfaceOnly:=True  ' もう一度マクロでの操作を可能にして、保護をかければOK
ActiveWorkbook.Worksheets(1).Cells(1, 1).Value = "HJK"     ' これならエラーにならない

マクロでしかシートを再表示できないようにする

Worksheets.Add After:=Worksheets(Sheets.Count)
ActiveSheet.Name = "Hidden"

Worksheets("Hidden").Visible = xlVeryHidden    ' マクロからしかシートを再表示できないように設定し、非表示にする

Worksheets("Hidden").Visible = xlSheetVisible    ' 再表示する
    
'***  VBEで、シートのプロパティウィンドウから、Visibleの値を2に変更してもいい

シートのコードの宣言部に記述した変数の値について　シートを切り替えても値を保持するらしい

Option Explicit

Dim long1 As Long
Dim long2 As Long

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  long1 = long1 + 10
  long2 = long2 + 100
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Debug.Print "long1: " & long1
  Debug.Print "long2: " & long2
End Sub

'選択範囲を変更した時に、long1とlong2の値を出力
'ダブルクリック時に、long1とlong2の値を増加させている
'このシートを非アクティブにして、再びアクティブにした時は、long1とlong2は前の値を保持している
'通常の変数に限らず、オブジェクト型やクラスのインスタンスも保持するらしい

シートのコードで、グローバル変数や通常のプロシージャを設定する

Option Explicit

Private currentRange As Range
'シートのコード内で使えるグローバル変数。現在選択されているセル範囲を格納
Private long1 As Long

'グローバル変数の内容は、ブックが閉じられるまでは保持されるようだ


Private Sub Worksheet_Activate()
  If currentRange Is Nothing Then  'まだcurrentRangeがSetされていない場合
    Set currentRange = Me.Range("A1") ' シートのコードでは、Meはこのシートになる
    Me.Cells.Interior.ColorIndex = 0  'シート全体の背景色を無色に
    long1 = 100
  End If

End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)   '選択範囲が変更された時の処理
  currentRange.Interior.ColorIndex = 0  'currentRangeの範囲の背景色を無色に
  Set currentRange = Target        '新しく選択された範囲をcurrentRangeにSet
  Target.Interior.ColorIndex = 6   '新しく選択された範囲を黄色に
  
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)  'シートに変更(多分セルの値の変更)があった時
  long1 = long1 + 200
  Call Tekitou  'シートのコード内でも通常のプロシージャは使える
End Sub

Private Sub Tekitou()
  MsgBox "long1の値：" & long1
End Sub

オートフィルタでデータの絞込み、絞込みの解除。絞込みの条件指定や、日付での指定方法など

フィルタに関してはここに大体まとめた　　VBAサンプルブックとして、「オートフィルタ検証.xlsm」というものを作成してある

Sub AAA()  '*******　　絞込みの解除  **************
  
  If ActiveSheet.FilterMode = True Then   ' オートフィルタでデータの絞込みがされている場合
    ActiveSheet.ShowAllData
    ' データの絞込みを解除。フィルタそのものを解除ではなく、絞込み無しにして全てのデータを表示している状態に
  End If
  
  
  If ActiveSheet.FilterMode = True Then
    ActiveSheet.AutoFilterMode = False    ' これはオートフィルタそのものを解除してしまう
  End If
  
End Sub



Sub BBB()  '**********   条件を指定して絞り込む   ***************

Cells(2, 2).AutoFilter Field:=2, Criteria1:="オレンジ"
' セルB2を含む有効セル範囲で、左から2番目の列を "=オレンジ" の条件でフィルタリングする
' オートフィルタが未設定の場合は設定される

'Range("B2").AutoFilter Field:=2, Criteria1:="オレンジ"  この表記でもいい

Cells(2, 2).AutoFilter 2, "オレンジ"
' このように省略できる。上と同じ処理になる




Cells(2, 2).AutoFilter 3, "<>家電"   'これは「家電に一致しない」という条件
Range("B2").AutoFilter 2, "<>"         'これは「空白ではない」という条件
Range("B2").AutoFilter 2, ""           'これは「空白」という条件
Range("B2").AutoFilter 2, "*麦"         ' * でワイルドカードも使える。「小麦」・「大麦」等がヒット
Range("B2").AutoFilter 2, "~*~?AA"
'*?を条件に含める場合は、半角チルダでエスケープする・「*?AA」というセルがヒット

Range("B2").AutoFilter 2, "==AA"
'=<>を条件に含める場合は、=でエスケープする。半角チルダでは駄目。「=AA」がヒット

Range("B2").AutoFilter 2, " リンゴ "
'セルの文字列の前後にあるに半角スペースは無視されるらしい。条件に入れても無視されるみたい
Range("B2").AutoFilter 2, "リン  ゴ"    'この場合は、スペースは無視されない

Range("B2").AutoFilter 2, "リンゴ"
Range("B2").AutoFilter 5, ">=10000"
' 複数の列に条件を指定。第2列 = "リンゴ"  AND  第5列 >=10000   の条件になる

Range("B2").AutoFilter Field:=2, Criteria1:="小麦", Operator:=xlOr, Criteria2:="ぶどう"
' 1列に複数の条件を設定。第2列 = "小麦"  OR  第2列 = "ぶどう" の条件になる
Range("B2").AutoFilter 2, "小麦", xlOr, "ぶどう"   '省略形も可能


Range("B2").AutoFilter 5, ">=15000", xlAnd, "<=55000"
' こちらは第5列の値が 15000以上かつ55000以下　の条件になる


Range("B2").AutoFilter Field:=2, Criteria1:=Array("リンゴ", "ぶどう", "キャベツ"), Operator:=xlFilterValues
' Excel2007以降限定で、Operator:=xlFilterValues とすることで1列に3つ以上の条件を設定できる

'Range("B2").AutoFilter Field:=1, Criteria1:="リンゴ", Criteria2:="ぶどう", Criteria3:="キャベツ", Operator:=xlFilterValues
'※この表記は不可

Range("B2").AutoFilter 2, "*麦"   ' ワイルドカード指定も可能。
Range("B2").AutoFilter 2, "???"   ' 任意の3文字


Cells(2, 2).AutoFilter Field:=2, Criteria1:="洗濯機"
Cells(2, 2).CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Cells(10009, 2)
' データの絞込みで抽出されたセルのみをコピーし、セルB25に貼り付ける(可視セルのみをコピーすることで実現している)
'　※Excel2002以降は、可視セルに限定しなくてもいけるらしい

Cells(2, 2).AutoFilter Field:=2, Criteria1:="麦茶"
Cells(2, 2).CurrentRegion.Copy Cells(10009, 2)
'Excel2016はこれでもOK
    
    
  
'**********  数値での条件設定  **********
'大小比較
Cells(2, 11).AutoFilter 1, ">50000"  'セルの書式が通常の数値であれば、値で比較できる
Cells(2, 11).AutoFilter 2, ">40000"  'セルの書式が「100,000」のように3桁区切りでも、値で比較できるらしい
Cells(2, 11).AutoFilter 3, ">60000"  'セルの書式が「\100,000」のように通貨形式でも、値で比較できるらしい
Cells(2, 11).AutoFilter 4, ">12000"  'セルの書式が「00000円」のようにユーザー定義でも、値で比較できるらしい

'等しいという条件。これは注意が必要
Cells(2, 11).AutoFilter 1, "=5000"    'セルの書式が通常の数値であれば、値で比較できる
Cells(2, 11).AutoFilter 2, "=5000"    'セルの書式が「100,000」のように3桁区切りだと、=条件ではヒットしない
Cells(2, 11).AutoFilter 2, "=5,000"   'これはヒットする。区切りの「,」が必要になる
Cells(2, 11).AutoFilter 3, "=5000"    'セルの書式が「\100,000」のように通貨形式だと、=条件ではヒットしない
Cells(2, 11).AutoFilter 3, "=\5,000"  'これはヒットする。区切りの「,」と「\」が必要になる
Cells(2, 11).AutoFilter 4, "=5000"    'セルの書式が「00000円」のようにユーザー定義だと、=条件ではヒットしない
Cells(2, 11).AutoFilter 4, "=05000"    'これもヒットしない
Cells(2, 11).AutoFilter 4, "=05000円"  'これはヒットする。「円」が必要になる

End Sub


Sub CCC()  '********　日付での絞りこみ    *************


Cells(2, 11).AutoFilter 6, ">=2022/1/1"
'日付でも大小比較の指定は可能らしい

Cells(2, 11).AutoFilter 6, ">=2020/1/5", xlAnd, "<=2020/3/5"
'これも可能



'※以下は少し難しい

Cells(2, 11).AutoFilter 6, "2020/1/1"
' Excelのバージョンは2016、セルの書式設定は「標準」「日付」「文字列」の場合、この表記で絞込みできる

' ※日付での絞り込みは、エクセルのバージョンやセルの書式設定によって、絞込みの可否や結果が変わるらしい
' 詳しくはリンク先を参照。日付で絞込みは、単純な形式のみにしたほうがよさそう



' ※Excel2007以降限定、セルの書式設定「標準」「日付」の場合、以下のような絞込みが可能

Cells(2, 2).AutoFilter Field:=6, Operator:=xlFilterValues, _
  Criteria2:=Array(1, "2020/1/1", 1, "2020/2/3", 1, "2020/3/5")
' Criteria1:= ではなく、 Criteria2:= であることに注意
' 1, "2020/1/1"  の1は、「月」を指定している。
' "2020/1/1"の月なので、2020年の1月のデータを条件にしていることになる(1日は無関係)
' 上の場合は、2020年の1月・2月・3月のデータのみを絞り込むことになる。何日であるかは無視する

Cells(2, 2).AutoFilter Field:=6, Operator:=xlFilterValues, _
Criteria2:=Array(2, "2021/1/1", 2, "2021/2/3", 2, "2021/3/5")
' 2は「日」を指定するので、この場合は"2021/1/1"・"2021/2/3"・"2021/3/5"の3日分のデータのみを絞り込む

Range("B2").AutoFilter Field:=6, Operator:=xlFilterValues, _
Criteria2:=Array(0, "2019/1/1", 0, "2020/2/3", 0, "2022/3/5")
' 0は「年」を指定するので、この場合は2019年・2020年・2022年のデータで絞り込む

End Sub

オートフィルタで、特定の条件で絞込みをしたデータ範囲を、Variant型配列へ格納する

意外と面倒な話　　VBAサンプルブックとして、「オートフィルタ検証.xlsm」というものを作成してある

Sub GGG()
  Dim var1 As Variant

  Worksheets("データ4").Cells.Clear
  
  Worksheets("データ5").Activate
  Worksheets("データ5").Range(Cells(2, 2), Cells(32, 5)).Copy
  
  Worksheets("データ4").Activate
  Worksheets("データ4").Cells(2, 2).Select
  Worksheets("データ4").Paste
  
  Cells(2, 2).AutoFilter 2, "スイカ"  'フィルタをかける

  Cells(2, 2).CurrentRegion.Offset(1, 0).Resize(Cells(2, 2).CurrentRegion.Offset(1, 0).Rows.Count - 1).Select
  var1 = Selection.Value  'これは全データが格納されてしまい、フィルタリングの意味が無い

  Cells(2, 2).CurrentRegion.Offset(1, 0).Resize(Cells(2, 2).CurrentRegion.Offset(1, 0).Rows.Count - 1).SpecialCells(xlCellTypeVisible).Select
  var1 = Selection.Value
  'これは、データ部分の1行目から、非表示になっている最初の行の手前までしか選択されない
  
  Selection.Copy  '絞り込んだ状態の範囲をコピー
  Cells(35, 2).Select
  Worksheets("データ4").Paste  '別のセルへ貼り付けする
  var1 = Selection.Value
  'こうすると、var1にはフィルタリングした範囲の値が格納される。結構面倒だな
  
Stop
End Sub