Private Sub cmb1_Click()
      ' Call download  'こちらを消して下記を追加
     Call 銘柄リスト作成
End Sub

Sub download()
Application.ScreenUpdating = False

'シートの種類チェックと画像削除
On Error Resume Next
    If ActiveSheet.Type <> xlWorksheet Then
        Workbooks.Add
    Else
       Sheets.Add
       For Each sheet_name In Worksheets
            If sheet_name.Name = ("時系列株価") Then
                Worksheets("時系列株価").Select
                Application.DisplayAlerts = False
                    ActiveWindow.SelectedSheets.Delete
                Application.DisplayAlerts = True
                    
            End If
        Next
    End If
On Error GoTo 0
Sheets.Add.Name = "時系列株価"

Sheets.Add.Name = "(" & zno + 1 & ")" & dat2(zno, 0) '変更

datbook = ActiveWorkbook.Name
UserForm1.txt1.Text = ""
　・
　・

Public dat2() As String      '表示銘柄datはModule1で使用済みでダブルのでこちらは2を付けた
Public zno As Integer        '自動実行No
Public zsu As Integer        '自動実行数量
Public datbook As String     '追加ブック名

Sub 銘柄リスト作成()

ReDim dat2(3000, 1) As String　　’dat →　dat2 

If UserForm1.txt1.Text <> "" Then
    Call 銘柄1個
    Exit Sub
End If

If UserForm1.txt3.Text <> "" Then
   ' Call 銘柄1個
   zsu = 0
    dat2(0, 0) = UserForm1.txt3.Text 
    Call 連続実行
    Exit Sub
End If

'ファイル指定
 flt$ = "txtファイル(*.txt),*.txt"
fff = Application.GetOpenFilename(flt$, , Title:="txtファイル指定")

If fff = "False" Then
      MsgBox "銘柄コード記載のtxtファイルを指定して下さい"
      Exit Sub
End If

'Call シート追加

 ・・・略・・

    Input #1, dat2(i, 0), dat2(i, 1)  ’dat →　dat2 
・・・略・・

'Range(Cells(2, 1), Cells(i + 1, 2)).Value = dat
'Call 不用シート削除
'UserForm1.Label2.Caption = fff & "から[" & i & "]件取り込みました"

UserForm1.txt1.Text = fff & "から[" & i & "]件取り込みました"
zsu = i - 1

Call 連続実行    '新規追加

Exit Sub
rest:
 ・・・略　・・・
End Sub
’------------------------------------------------------------------------------------

Sub 連続実行()

'ブック追加
Workbooks.Add
datbook = ActiveWorkbook.Name

For zno = 0 To zsu
    Application.StatusBar = "解析実行中---" & zno + 1 & "/" & zsu + 1
    
    UserForm1.txt3.Text = dat2(zno, 0)　　’配列のデータをテキストボックスへ記入
    Windows(datbook).Activate　　　　　　
    
    Call download　　　　　　　　　　　’データ取得＆ボリンジャーバンドで解析

    ActiveSheet.Move After:=Worksheets(Worksheets.Count)　　’追加シートを最終へ

    Application.ScreenUpdating = True　　　’取りあえず実行結果を見る
    Application.ScreenUpdating = False
Next

Call 不用シート削除　　　　　　　　　　　　

Application.StatusBar = "解析実終了"
End Sub

Sub 連続解析()
Dim kaik(5) As String '買い結果
Dim urik(5) As String '売り結果

Application.ScreenUpdating = False
For Each sheet_name In Worksheets
        shname = sheet_name.Name
         
    If shname <> uksh Then
        Sheets(shname).Select
        For i = 0 To 4                   '５日間の場合
            If kaik(i) = "" Then
                 kaik(i) = Cells(i + 4, 1) & ": "
                 urik(i) = Cells(i + 4, 1) & ": "
            End If
        
            If Cells(i + 4, 7) = "買い検討" Then
                 kaik(i) = kaik(i) & "[" & shname & "]　"
            End If
            If Cells(i + 4, 7) = "売り検討" Then
                 urik(i) = urik(i) & "[" & shname & "]　"
            End If
        Next
    End If
Next
msg = kaik(0) & Chr(10) & kaik(1) & Chr(10) & _
        kaik(2) & Chr(10) & kaik(3) & Chr(10) & kaik(4)
kari = MsgBox(msg, 0, "買い抽出銘柄")

msg = urik(0) & Chr(10) & urik(1) & Chr(10) & _
        urik(2) & Chr(10) & urik(3) & Chr(10) & urik(4)
kari = MsgBox(msg, 0, "売り抽出銘柄")

End Sub