エクセルファイルからのデータ収集。取り出し条件設定シート作成

Option Explicit

Private Path As String, i As Long
Private CndN As String, Cnd As Variant
Private CneN As String, Cne As Variant
Private CnfN As String, Cnf As Variant
Private CngN As String, Cng As Variant
Private CnhN As String, Cnh As Variant
Private Sna(1000) As Variant
Private Arow, NO, Result As Long
Private Flag As Boolean

Sub シート名取出し()
    Dim St As Worksheet
    Dim R As Long
    Dim flg As Boolean
    Dim An As String
    ChDir ThisWorkbook.Path
        On Error Resume Next
        flg = Application.FindFile
        On Error GoTo 0
        If flg = False Then Exit Sub
        An = ActiveWorkbook.Name
        R = 4
        For Each St In Worksheets
            Workbooks("データ収集.xlsm").Activate
            Worksheets("設定").Cells(R, 1).Value = St.Name
            With Range(Cells(R, 1), Cells(R, 2))
                .Interior.ColorIndex = 6
                .Borders.LineStyle = xlContinuous
            End With
            R = R + 1
            Workbooks(An).Activate
        Next
        Workbooks(An).Close False
End Sub

Sub 変数設定()

        Call Module1.シート名取出し
        Workbooks("データ収集.xlsm").Activate
        With Worksheets("設定")
            .Range("A3") = "シート名"
            .Range("B2") = "シートチェック"
            .Range("B3") = "抽出に〇"
            .Range("C2") = "項目名"
            .Range("C3") = "セル番号"
            .Range("D1") = "抽出データ１"
            .Range("E1") = "抽出データ２"
            .Range("F1") = "抽出データ３"
            .Range("G1") = "抽出データ４"
            .Range("H1") = "抽出データ５"
            .Range("D2", "H3").Interior.ColorIndex = 6
            With .Range("A1", "H1")
                .Font.Size = 15
                .Font.ColorIndex = 5
                .Font.Bold = True
            End With
            With .Range("A2", "C3")
                .Font.Size = 15
                .Font.ColorIndex = 5
                .Font.Bold = True
            End With
                .Range("D1", "H3").Borders.LineStyle = xlContinuous
                .Range("A2", "C3").Borders.LineStyle = xlContinuous
                .Columns.AutoFit
        End With
        MsgBox "取り出し条件設定シートの作成が完了しました", _
                    vbInformation, "複数エクセルファイルデータ収集"
End Sub